|
|
| Line 1: |
Line 1: |
| − | __TOC__
| + | * [[ROUTINE PSJLMHED]] |
| − | == [[ROUTINE PSJLMHED]] ==
| |
| − | <pre>
| |
| − | PSJLMHED * * 136 LINES, 7779 BYTES, RSUM: 20609137/50472528 Page 1
| |
| − | UCI: EHR,EHR Site: Central Regional Hospital MAY 17,2015@23:33
| |
| − | | |
| − | </pre>
| |
| − | == PSJLMHED^PSJLMHED ==
| |
| − | === PSJLMHED^PSJLMHED INTEGRATION AGREEMENTS ===
| |
| − | [[IA 2191]] [[IA 2831]] [[IA 10040]] [[IA 5425]] [[IA 5770]] [[IA 5785]] [[IA 5140]] [[IA 5787]]
| |
| − | === PSJLMHED^PSJLMHED REFERENCED BY ===
| |
| − | === PSJLMHED^PSJLMHED REFERS TO ===
| |
| − | * [[GLOBAL ^PS(55]] [[GLOBAL ^SC]] [[ROUTINE ORQPT2]] [[ROUTINE PSSDSAPI]]
| |
| − | <pre>
| |
| − | 1 PSJLMHED --
| |
| − | ;BIR/MLM-BUILD LM HEADERS ;28 Jan 98 / 2:18 PM
| |
| − | 2 +1 ;;5.0;INPATIENT MEDICATIONS;**4,58,85,110,148,181,260**;16 DEC 97;B
| |
| − | uild 94
| |
| − | 3 +2 ;
| |
| − | 4 +3 ; Reference to ^PS(55 is supported by DBIA 2191.
| |
| − | 5 +4 ; Reference to CWAD^ORQPT2 is supported by DBIA 2831.
| |
| − | 6 +5 ; Reference to ^SC is supported by DBIA 10040.
| |
| − | 7 +6 ;External reference to $$BSA^PSSDSAPI supported by DBIA 5425.
| |
| − | 8 +7 ;External reference to ^ORQQVI supported by DBIA 5770.
| |
| − | 9 +8 ;External reference to ^ORQPTQ4 supported by DBIA 5785.
| |
| − | 10 +9 ;External reference to ^ORB31 supported by DBIA 5140.
| |
| − | 11 +10 ;External reference to ^ORQQLR1 supported by DBIA 5787.
| |
| − | 12 +11 ;
| |
| − | </pre>
| |
| − | == HDR(DFN)^PSJLMHED ==
| |
| − | === HDR(DFN)^PSJLMHED INTEGRATION AGREEMENTS ===
| |
| − | === HDR(DFN)^PSJLMHED REFERENCED BY ===
| |
| − | === HDR(DFN)^PSJLMHED REFERS TO ===
| |
| − | === HDR(DFN)^PSJLMHED CALLED BY ===
| |
| − | === HDR(DFN)^PSJLMHED CALLS ===
| |
| − | * [[ROUTINE PSJAC#ENBOTH|ENBOTH^PSJAC]] [[ROUTINE VALM1#SETSTR|$$SETSTR^VALM1]] [[ROUTINE PSSDSAPI#BSA|$$BSA^PSSDSAPI]] [[ROUTINE PSGMI#ENDTC|$$ENDTC^PSGMI]]
| |
| − | === HDR(DFN)^PSJLMHED LOCKS ===
| |
| − | === HDR(DFN)^PSJLMHED LOCALS ===
| |
| − | === HDR(DFN)^PSJLMHED GLOBALS ===
| |
| − | === HDR(DFN)^PSJLMHED CODE ===
| |
| − | <pre>
| |
| − | 13 HDR(DFN) --
| |
| − | ; -- list screen header
| |
| − | 14 +1 ; input: DFN := ifn of pat
| |
| − | 15 +2 ; output: VALMHDR() := hdr array
| |
| − | 16 +3 ;
| |
| − | 17 +4 K VAIN,VADM,GMRA,PSJACNWP,PSJ,VAERR,VA,X
| |
| − | 18 +5 S PSJACNWP=1 D ENBOTH^PSJAC
| |
| − | 19 +6 D HDRO(DFN)
| |
| − | 20 +7 S PSJ=" Sex: "_$P(PSJPSEX,U,2),VALMHDR(4)=$$SETSTR^VALM1($S(PSJPD
| |
| − | D:"Last ",1:" ")_"Admitted: "_$P(PSJPAD,U,2),PSJ,45,23)
| |
| − | 21 +8 S PSJ=" Dx: "_PSJPDX
| |
| − | 22 +9 S:PSJPDD VALMHDR(5)=$$SETSTR^VALM1("Discharged: "_$E($P(PSJPDD,U,2)
| |
| − | ,1,8),PSJ,48,26)
| |
| − | 23 +10 S:'PSJPDD VALMHDR(5)=$$SETSTR^VALM1("Last transferred: "_$$ENDTC^PS
| |
| − | GMI(PSJPTD),PSJ,42,26)
| |
| − | 24 +11 S PSJBSA=$$BSA^PSSDSAPI(DFN),PSJBSA=$P(PSJBSA,"^",3),PSJBSA=$S(PSJB
| |
| − | SA'>0:"__________",1:$J(PSJBSA,4,2))
| |
| − | 25 +12 S RSLT=$$CRCL(DFN)
| |
| − | 26 +13 I $P(RSLT,"^",2)["Not Found" S ZDSPL=" CrCL: "_$P(RSLT,"^",2)
| |
| − | 27 +14 E S ZDSPL=" CrCL: "_$P($G(RSLT),"^",2)_"(est.) "_"(CREAT:"_$P($G(R
| |
| − | SLT),"^",3)_"mg/dL "_$P($G(RSLT),"^")_")"
| |
| − | 28 +15 S PSJDB=$G(ZDSPL),VALMHDR(6)=$$SETSTR^VALM1("BSA (m2): "_$G(PSJBSA)
| |
| − | ,PSJDB,50,23) K PSJBSA
| |
| − | 29 +16 Q
| |
| − | 30 +17 ;
| |
| − | </pre>
| |
| − | == HDRO(DFN)^PSJLMHED ==
| |
| − | === HDRO(DFN)^PSJLMHED INTEGRATION AGREEMENTS ===
| |
| − | === HDRO(DFN)^PSJLMHED REFERENCED BY ===
| |
| − | === HDRO(DFN)^PSJLMHED REFERS TO ===
| |
| − | === HDRO(DFN)^PSJLMHED CALLED BY ===
| |
| − | === HDRO(DFN)^PSJLMHED CALLS ===
| |
| − | === HDRO(DFN)^PSJLMHED LOCKS ===
| |
| − | === HDRO(DFN)^PSJLMHED LOCALS ===
| |
| − | === HDRO(DFN)^PSJLMHED GLOBALS ===
| |
| − | === HDRO(DFN)^PSJLMHED CODE ===
| |
| − | <pre>
| |
| − | 31 HDRO(DFN) --
| |
| − | ; Standardized part of profile header.
| |
| − | 32 +1 N PSJCLIN,PSJAPPT,PSJCLINN,RMORDT S (PSJCLIN,PSJAPPT)=0,(RMORDAT,PS
| |
| − | JCLINN)="" I $G(PSJORD) D
| |
| − | 33 +2 . S PSJCLIN=$S($G(PSJORD)["V":$G(^PS(55,DFN,"IV",+PSJORD,"DSS")),$G
| |
| − | (PSJORD)["U":$G(^PS(55,DFN,5,+PSJORD,8)),$G(PSJORD)["P":$G(^PS(53.
| |
| − | 1,+PSJORD,"DSS")),1:"")
| |
| − | 34 +3 . S:PSJCLIN PSJAPPT=$P($G(PSJCLIN),U,2) I PSJCLIN,PSJAPPT S PSJCLIN
| |
| − | N=$P($G(^SC(+PSJCLIN,0)),U)
| |
| − | 35 +4 K VALMHDR I PSJCLINN]"" S PSJ=VADM(1),PSJ=$$SETSTR^VALM1(" Clinic
| |
| − | : "_PSJCLINN,PSJ,28,26)
| |
| − | 36 +5 I PSJCLINN="" S PSJ=VADM(1),PSJ=$$SETSTR^VALM1($S('PSJPDD:" ",1
| |
| − | :"Last ")_"Ward: "_PSJPWDN,PSJ,30,18)
| |
| − | 37 +6 S X=$$CWAD^ORQPT2(DFN)
| |
| − | 38 +7 S:X]"" X=IORVON_X_IORVOFF,PSJ=$$SETSTR^VALM1(X,PSJ,80-$L(X),80) S V
| |
| − | ALMHDR(1)=PSJ
| |
| − | 39 +8 S PSJ=" PID: "_$P(PSJPSSN,U,2)
| |
| − | 40 +9 S RMORDT=$S($G(PSJPDD):"Last ",1:" ")_"Room-Bed: "_$G(PSJPRB)
| |
| − | 41 +10 I PSJCLINN]"",PSJAPPT S RMORDT="Clinic Date: "_$$ENDTC^PSGMI(PSJAPP
| |
| − | T),RMORDT=$P(RMORDT," ")_" "_$P(RMORDT," ",2)
| |
| − | 42 +11 S PSJ=$$SETSTR^VALM1(RMORDT,PSJ,26,28),VALMHDR(2)=$$SETSTR^VALM1("H
| |
| − | t(cm): "_PSJPHT_" "_PSJPHTD,PSJ,55,25)
| |
| − | 43 +12 S PSJ=" DOB: "_$P($P(PSJPDOB,U,2)," ")_" ("_PSJPAGE_")",VALMHDR(3
| |
| − | )=$$SETSTR^VALM1("Wt(kg): "_PSJPWT_" "_PSJPWTD,PSJ,55,25)
| |
| − | 44 +13 Q
| |
| − | 45 +14 ;
| |
| − | </pre>
| |
| − | == INIT(PSJPROT)^PSJLMHED ==
| |
| − | === INIT(PSJPROT)^PSJLMHED INTEGRATION AGREEMENTS ===
| |
| − | === INIT(PSJPROT)^PSJLMHED REFERENCED BY ===
| |
| − | === INIT(PSJPROT)^PSJLMHED REFERS TO ===
| |
| − | === INIT(PSJPROT)^PSJLMHED CALLED BY ===
| |
| − | === INIT(PSJPROT)^PSJLMHED CALLS ===
| |
| − | === INIT(PSJPROT)^PSJLMHED LOCKS ===
| |
| − | === INIT(PSJPROT)^PSJLMHED LOCALS ===
| |
| − | === INIT(PSJPROT)^PSJLMHED GLOBALS ===
| |
| − | === INIT(PSJPROT)^PSJLMHED CODE ===
| |
| − | <pre>
| |
| − | 46 INIT(PSJPROT) --
| |
| − | ; -- init bld vars
| |
| − | 47 +1 ; PSJPROT=1:UD ONLY; 2:IV ONLY; 3:BOTH
| |
| − | 48 +2 K PSJUDPRF,^TMP("PSJ",$J),^TMP("PSJON",$J),^TMP("PSJPRO",$J)
| |
| − | 49 +3 S:PSJPROT=1 PSJUDPRF=1
| |
| − | 50 +4 D KILL^VALM10(),EN^PSJO1(PSJPROT)
| |
| − | 51 +5 I '$D(^TMP("PSJ",$J)) W !!,?22,"NO ORDERS FOUND FOR "_$S(PSJOL="S":
| |
| − | "SHORT",1:"LONG")_" PROFILE." S VALMQUIT=1 D PAUSE^PSJLMUTL Q
| |
| − | 52 +6 S PSJTF=0,PSJLN=1,PSJEN=1,PSJC="" F S PSJC=$O(^TMP("PSJ",$J,PSJC))
| |
| − | Q:PSJC="" D
| |
| − | 53 +7 .S PSJF="^PS("_$S("AO"[PSJC:"55,"_PSGP_",5,",PSJC="DF":"55,"_PSGP_"
| |
| − | ,5,",1:"53.1,")
| |
| − | 54 +8 .I PSJTF'=$E(PSJC,1)!(PSJC="CC")!(PSJC="CD")!(PSJC="BD") Q:PSJC="CB
| |
| − | " Q:PSJC="O" Q:PSJC="DF" D TF S PSJTF=$E(PSJC,1) ;DAM 8-29-0
| |
| − | 7 Added Q:PSJC="CB" Q:PSJC="O"
| |
| − | 55 +9 .S PSJST="" F S PSJST=$O(^TMP("PSJ",$J,PSJC,PSJST)) Q:PSJST="" D
| |
| − | 56 +10 .. S PSJS="" F S PSJS=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS)) Q:PSJS=""
| |
| − | Q:PSJC="CB" Q:PSJC="O" Q:PSJC="DF" D ON ;DAM 8-29-07 Ad
| |
| − | ded Q:PSJC="CB" Q:PSJC="O"
| |
| − | 57 +11 .;
| |
| − | 58 +12 .;DAM 8-29-07 New code to place Pending Orders after Pending Rene
| |
| − | wal Orders on the roll and scroll display. Non-Active Orders appe
| |
| − | ar last.
| |
| − | 59 +13 S PSJTF=0,PSJC="" F S PSJC=$O(^TMP("PSJ",$J,PSJC)) Q:PSJC="" D
| |
| − | 60 +14 . S PSJF="^PS("_$S("AO"[PSJC:"55,"_PSGP_",5,",PSJC="DF":"55,"_PSGP_
| |
| − | ",5,",1:"53.1,")
| |
| − | 61 +15 . I PSJC="CB" D TF S PSJTF=$E(PSJC,1) ;T
| |
| − | hese are Pending Orders
| |
| − | 62 +16 . I PSJC="CB" S PSJST="" F S PSJST=$O(^TMP("PSJ",$J,PSJC,PSJST)) Q
| |
| − | :PSJST="" D
| |
| − | 63 +17 . . S PSJS="" F S PSJS=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS)) Q:PSJS="
| |
| − | " D ON
| |
| − | 64 +18 . I PSJC="DF" D TF S PSJTF=$E(PSJC,1)
| |
| − | ;These are recently DC Orders (mv)
| |
| − | 65 +19 . I PSJC="DF" S PSJST="" F S PSJST=$O(^TMP("PSJ",$J,PSJC,PSJST)) Q
| |
| − | :PSJST="" D
| |
| − | 66 +20 . . S PSJS="" F S PSJS=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS)) Q:PSJS="
| |
| − | " D ON
| |
| − | 67 +21 . I PSJC="O" D TF S PSJTF=$E(PSJC,1) ;
| |
| − | These are Non-Active Orders
| |
| − | 68 +22 . I PSJC="O" S PSJST="" F S PSJST=$O(^TMP("PSJ",$J,PSJC,PSJST)) Q:
| |
| − | PSJST="" D
| |
| − | 69 +23 . . S PSJS="" F S PSJS=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS)) Q:PSJS="
| |
| − | " D ON
| |
| − | 70 +24 .; END DAM changes
| |
| − | 71 +25 .;
| |
| − | 72 +26 S VALMCNT=PSJLN-1
| |
| − | </pre>
| |
| − | == DONE^PSJLMHED ==
| |
| − | === DONE^PSJLMHED INTEGRATION AGREEMENTS ===
| |
| − | === DONE^PSJLMHED REFERENCED BY ===
| |
| − | === DONE^PSJLMHED REFERS TO ===
| |
| − | === DONE^PSJLMHED CALLED BY ===
| |
| − | === DONE^PSJLMHED CALLS ===
| |
| − | === DONE^PSJLMHED LOCKS ===
| |
| − | === DONE^PSJLMHED LOCALS ===
| |
| − | === DONE^PSJLMHED GLOBALS ===
| |
| − | === DONE^PSJLMHED CODE ===
| |
| − | <pre>
| |
| − | 73 DONE ;
| |
| − | 74 +1 K PSJC,PSJEN,PSJLN,PSJST,PSJS,CNT,PSJPRI
| |
| − | 75 +2 Q
| |
| − | 76 +3 ;
| |
| − | </pre>
| |
| − | == ON^PSJLMHED ==
| |
| − | === ON^PSJLMHED INTEGRATION AGREEMENTS ===
| |
| − | === ON^PSJLMHED REFERENCED BY ===
| |
| − | === ON^PSJLMHED REFERS TO ===
| |
| − | === ON^PSJLMHED CALLED BY ===
| |
| − | === ON^PSJLMHED CALLS ===
| |
| − | === ON^PSJLMHED LOCKS ===
| |
| − | === ON^PSJLMHED LOCALS ===
| |
| − | === ON^PSJLMHED GLOBALS ===
| |
| − | === ON^PSJLMHED CODE ===
| |
| − | <pre>
| |
| − | 77 ON ;
| |
| − | 78 +1 S PSJSCHT=$S(PSJOS:PSJS,1:PSJST)
| |
| − | 79 +2 S PSJO="" F FQ=0:0 S PSJO=$O(^TMP("PSJ",$J,PSJC,PSJST,PSJS,PSJO)) Q
| |
| − | :PSJO="" S DN=^(PSJO) D
| |
| − | 80 +3 .N PRJPRI S PSJPRI=$S(PSJO["V":$P($G(^PS(55,PSGP,"IV",+PSJO,.2)),"^
| |
| − | ",4),PSJO["U":$P($G(^PS(55,PSGP,5,+PSJO,.2)),"^",4),1:$P($G(^PS(53
| |
| − | .1,+PSJO,.2)),"^",4))
| |
| − | 81 +4 .S ^TMP("PSJON",$J,PSJEN)=PSJO,PSJL=$J(PSJEN,4) D @$S(PSJO["V":"PIV
| |
| − | ^PSJLMPRI(PSGP,PSJO,PSJF,DN)",PSJO["U":"PUD^PSJLMPRU(PSGP,PSJO,PSJ
| |
| − | F,DN)",1:"PIV^PSJLMPRI(PSGP,PSJO,PSJF,DN)") S ^TMP("PSJPRO",$J,0)=
| |
| − | PSJEN,PSJEN=PSJEN+1
| |
| − | 82 +5 Q
| |
| − | 83 +6 ;
| |
| − | </pre>
| |
| − | == TF^PSJLMHED ==
| |
| − | === TF^PSJLMHED INTEGRATION AGREEMENTS ===
| |
| − | === TF^PSJLMHED REFERENCED BY ===
| |
| − | === TF^PSJLMHED REFERS TO ===
| |
| − | === TF^PSJLMHED CALLED BY ===
| |
| − | === TF^PSJLMHED CALLS ===
| |
| − | === TF^PSJLMHED LOCKS ===
| |
| − | === TF^PSJLMHED LOCALS ===
| |
| − | === TF^PSJLMHED GLOBALS ===
| |
| − | === TF^PSJLMHED CODE ===
| |
| − | <pre>
| |
| − | 84 TF ; Set up order type header
| |
| − | 85 +1 NEW PSJDFHDR
| |
| − | 86 +2 I $D(^TMP("PSJ",$J,PSJC)) D
| |
| − | 87 +3 .S PSJDCEXP=$$RECDCEXP^PSJP()
| |
| − | 88 +4 .S PSJDFHDR="RECENTLY DISCONTINUED/EXPIRED (LAST "_+$G(PSJDCEXP)_"
| |
| − | HOURS)"
| |
| − | 89 +5 .N C,X,Y S C=PSJC,Y="",$P(Y," -",40)=""
| |
| − | 90 +6 .S X=$S(C="A":$$TXT^PSJO("A"),C["CC":$$TXT^PSJO("PR"),C["CD":$$TXT^
| |
| − | PSJO("PC"),C["C":$$TXT^PSJO("P"),C["BD":$$TXT^PSJO("NC"),C["B":$$T
| |
| − | XT^PSJO("N"),C["DF":PSJDFHDR,1:$$TXT^PSJO("NA"))
| |
| − | 91 +7 .S ^TMP("PSJPRO",$J,PSJLN,0)=$E($E(Y,1,(80-$L(X))/2)_" "_X_$E(Y,1,(
| |
| − | 80-$L(X))/2),1,80),PSJLN=PSJLN+1
| |
| − | 92 +8 Q
| |
| − | </pre>
| |
| − | == TEST^PSJLMHED ==
| |
| − | === TEST^PSJLMHED INTEGRATION AGREEMENTS ===
| |
| − | === TEST^PSJLMHED REFERENCED BY ===
| |
| − | === TEST^PSJLMHED REFERS TO ===
| |
| − | === TEST^PSJLMHED CALLED BY ===
| |
| − | === TEST^PSJLMHED CALLS ===
| |
| − | === TEST^PSJLMHED LOCKS ===
| |
| − | === TEST^PSJLMHED LOCALS ===
| |
| − | === TEST^PSJLMHED GLOBALS ===
| |
| − | === TEST^PSJLMHED CODE ===
| |
| − | <pre>
| |
| − | 93 TEST ;
| |
| − | 94 +1 N X,Y S Y="",$P(Y," -",40)=""
| |
| − | 95 +2 F X="A C T I V E","P E N D I N G R E N E W A L S","P E N D I N G
| |
| − | ","N O N - V E R I F I E D","N O N - A C T I V E" W !,$E($E(Y,1,(8
| |
| − | 0-$L(X))/2)_" "_X_$E(Y,1,(80-$L(X))/2),1,80)
| |
| − | 96 +3 Q
| |
| − | </pre>
| |
| − | == CRCL(DFN)^PSJLMHED ==
| |
| − | === CRCL(DFN)^PSJLMHED INTEGRATION AGREEMENTS ===
| |
| − | === CRCL(DFN)^PSJLMHED REFERENCED BY ===
| |
| − | === CRCL(DFN)^PSJLMHED REFERS TO ===
| |
| − | === CRCL(DFN)^PSJLMHED CALLED BY ===
| |
| − | === CRCL(DFN)^PSJLMHED CALLS ===
| |
| − | === CRCL(DFN)^PSJLMHED LOCKS ===
| |
| − | === CRCL(DFN)^PSJLMHED LOCALS ===
| |
| − | === CRCL(DFN)^PSJLMHED GLOBALS ===
| |
| − | === CRCL(DFN)^PSJLMHED CODE ===
| |
| − | <pre>
| |
| − | 97 CRCL(DFN) --
| |
| − | ;
| |
| − | 98 +1 N HTGT60,ABW,IBW,BWRATIO,BWDIFF,LOWBW,ADJBW,X1,X2,RSLT,PSCR,PSRW,AB
| |
| − | W,ZHT,PSRH,PSCXTL,PSCXTLS,SCR,OCXT,OCXTS,SCRV,ZAGE,SEX
| |
| − | 99 +2 S RSLT="0^<Not Found>"
| |
| − | 100 +3 S PSCR="^^^^^^0"
| |
| − | 101 +4 D VITAL^ORQQVI("WEIGHT","WT",DFN,.PSRW,0,"",$$NOW^XLFDT)
| |
| − | 102 +5 Q:'$D(PSRW) RSLT
| |
| − | 103 +6 S ABW=$P(PSRW(1),U,3) Q:+$G(ABW)<1 RSLT
| |
| − | 104 +7 S ABW=ABW/2.2 ;ABW (actual body weight) in kg
| |
| − | 105 +8 D VITAL^ORQQVI("HEIGHT","HT",DFN,.PSRH,0,"",$$NOW^XLFDT)
| |
| − | 106 +9 Q:'$D(PSRH) RSLT
| |
| − | 107 +10 S ZHT=$P(PSRH(1),U,3) Q:+$G(ZHT)<1 RSLT
| |
| − | 108 +11 S ZAGE=$$AGE^ORQPTQ4(DFN) Q:'ZAGE RSLT
| |
| − | 109 +12 S SEX=$P($$SEX^ORQPTQ4(DFN),U,1) Q:'$L(SEX) RSLT
| |
| − | 110 +13 S PSCXTL="" Q:'$$TERMLKUP^ORB31(.PSCXTL,"SERUM CREATININE") RSLT
| |
| − | 111 +14 S PSCXTLS="" Q:'$$TERMLKUP^ORB31(.PSCXTLS,"SERUM SPECIMEN") RSLT
| |
| − | 112 +15 S SCR="",OCXT=0 F S OCXT=$O(PSCXTL(OCXT)) Q:'OCXT D
| |
| − | 113 +16 .S OCXTS=0 F S OCXTS=$O(PSCXTLS(OCXTS)) Q:'OCXTS D
| |
| − | 114 +17 ..S SCR=$$LOCL^ORQQLR1(DFN,$P(PSCXTL(OCXT),U),$P(PSCXTLS(OCXTS),U))
| |
| − | 115 +18 ..I $P(SCR,U,7)>$P(PSCR,U,7) S PSCR=SCR
| |
| − | 116 +19 S SCR=PSCR,SCRV=$P(SCR,U,3) Q:+$G(SCRV)<.01 RSLT
| |
| − | 117 +20 S SCRD=$P(SCR,U,7) Q:'$L(SCRD) RSLT
| |
| − | 118 +21 ;
| |
| − | 119 +22 S HTGT60=$S(ZHT>60:(ZHT-60)*2.3,1:0) ;if ht > 60 inches
| |
| − | 120 +23 I HTGT60>0 D
| |
| − | 121 +24 .S IBW=$S(SEX="M":50+HTGT60,1:45.5+HTGT60) ;Ideal Body Weight
| |
| − | 122 +25 .S BWRATIO=(ABW/IBW) ;body weight ratio
| |
| − | 123 +26 .S BWDIFF=$S(ABW>IBW:ABW-IBW,1:0)
| |
| − | 124 +27 .S LOWBW=$S(IBW<ABW:IBW,1:ABW)
| |
| − | 125 +28 .I BWRATIO>1.3,(BWDIFF>0) S ADJBW=((0.3*BWDIFF)+IBW)
| |
| − | 126 +29 .E S ADJBW=LOWBW
| |
| − | 127 +30 I +$G(ADJBW)<1 D
| |
| − | 128 +31 .S ADJBW=ABW
| |
| − | 129 +32 S CRCL=(((140-ZAGE)*ADJBW)/(SCRV*72))
| |
| − | 130 +33 ;
| |
| − | 131 +34 S:SEX="M" RSLT=SCRD_U_$J(CRCL,1,1)
| |
| − | 132 +35 S:SEX="F" RSLT=SCRD_U_$J((CRCL*.85),1,1)
| |
| − | 133 +36 S X1=$P(RSLT,"^"),X2=$$FMTE^XLFDT(X1,"2M"),$P(RSLT,"^")=$P(X2,"@")
| |
| − | K X1,X2
| |
| − | 134 +37 S $P(RSLT,"^",3)=$P($G(SCR),"^",3)
| |
| − | 135 +38 K HTGT60,ABW,IBW,BWRATIO,BWDIFF,LOWBW,ADJBW,X1,X2,PSCR,PSRW,ABW,ZHT
| |
| − | ,PSRH,ZAGE,PSCXTL,PSCXTLS,SCR,OCXT,OCXTS,SCRV,CRCL
| |
| − | 136 +39 Q RSLT
| |
| − | | |
| − | | |
| − | </pre>
| |
| − | [[Category:ROUTINE]][[Category:ROUTINE PSJLMHED]]
| |
