- PSJAC ;BIR/CML3-INPATIENT INFORMATION ;29-May-2012 14:37;PLS
- ;;5.0; INPATIENT MEDICATIONS ;**8,10,50,127,1015**;16 DEC 97;Build 62
- ;
- ; Reference to ^PS(55 is supported by DBIA# 2191.
- ; Modified - IHS/CIA/PLS - 12/11/03 - Line HTWT+2
- S DFN=PSGP,PSJACPF=1 G CHK
- ;
- ENBOTH ;
- S PSJACPF=11 G CHK
- ;
- ENIV ;
- N I,J,JJ,ON,PSJRBXX,X,X1,X2,X,Y S PSJACPF=10,PSGP=DFN
- ;
- CHK ;
- ;Check if 5.0 order conversion should be run for the selected patient.
- ;I '$P($G(^PS(55,DFN,5.1)),U,11) D CONVERT^PSJUTL1(DFN,$S($E(IOST,1)="C":1,1:0))
- ;/Commented out in PSJ*5*50. No longer needed
- ;/F S PSJRBXX=$$OTF^OR3CONV(DFN,$S($E(IOST,1)="C":0,1:1)) Q:+PSJRBXX'<0 D
- ;/.I +PSJRBXX=-1 W:$E(IOST,1)="C" !,$P(PSJRBXX,"^",2) H 4
- ;Converting IV order to new OI with POE if not done so when installed PSJ*5*50
- D CNIV^PSJUTL1(DFN)
- ;I $D(^PS(55,DFN,0)),'$P($G(^PS(55,DFN,0)),U,6) D EN^PSOHLUP(DFN)
- S VA200=1 D INP^VADPT
- I VAIN(4) S:PSJACPF#2 PSJPCAF=1_"^"_VAIN(1),PSJPWD=+VAIN(4),PSJPWDN=$P(VAIN(4),"^",2),PSJPTS=+VAIN(3),PSJPTSP=+VAIN(2),PSJPRB=VAIN(5),PSJPAD=+VAIN(7),PSJPDX=VAIN(9),PSJPTD=$S($D(^PS(55,PSGP,5.1)):$P(^(5.1),"^",4),1:""),PSJPDD="" G CNV
- S VAIP("D")="L" D IN5^VADPT G:PSJACPF[0 CNV
- S PSJPCAF="",PSJPAD=+VAIP(13,1)
- S PSGID=+VAIP(3),X=+VAIP(4)=12!(+VAIP(4)=38),PSJPWD=+VAIP(5),PSJPWDN=$P(VAIP(5),"^",2),PSJPRB=$P(VAIP(6),"^",2),PSJPTSP=+VAIP(7),PSJPTS=+VAIP(8),PSJPDX=VAIP(9),PSJPTD="",PSJPDD=PSGID_"^"_$$ENDTC^PSGMI(PSGID) S:X PSJPDD=PSJPDD_"^1"
- ;
- CNV ;
- D DEM^VADPT,HTWT(PSGP)
- I PSJACPF#2 S PSGP(0)=VADM(1),PSJPSSN=VADM(2),PSJPDOB=+VADM(3),PSJPAGE=VADM(4),PSJPSEX=$S(VADM(5)]"":VADM(5),1:"?^____"),PSJPPID=VA("PID"),PSJPBID=VA("BID")
- I PSJACPF#2 D
- .I $D(PSJY2K) D Q
- ..F X="PSJPAD","PSJPDOB","PSJPTD" I @X S $P(@X,"^",2)=$$ENDTC2^PSGMI(+@X)
- .F X="PSJPAD","PSJPDOB","PSJPTD" I @X S $P(@X,"^",2)=$$ENDTC^PSGMI(+@X)
- ;
- WP ; ward parameters
- G:$D(PSJACNWP) DONE S PSJSYSW0="",PSJSYSW=0 I $G(PSJPWD) S PSJSYSW=+$O(^PS(59.6,"B",PSJPWD,0)) I PSJSYSW S PSJSYSW0=$G(^PS(59.6,PSJSYSW,0))
- ;S PSJSYSL="",X=$P(PSJSYSU,";",3)>1 S PSJSYSL=$P(PSJSYSW0,"^",X*4+12) G:$D(PSJACND) DONE
- S PSJSYSL="",X=$P(PSJSYSU,";",3)>1 S PSJSYSL=$S(X=0:$P(PSJSYSW0,"^",12),1:$P(PSJSYSW0,"^",16)) G:$D(PSJACND) DONE
- I PSJSYSL D
- .S:X X='$P($G(PSJSYSP0),"^",10) S IOP=$S($P($G(PSJSYSP0),"^",13)]"":$P($G(PSJSYSP0),"^",13),$P(PSJSYSW0,"^",19+X)]"":$P(PSJSYSW0,"^",19+X),1:"") I IOP]"" D
- ..S IOP="`"_IOP K %ZIS S %ZIS="NQ" D ^%ZIS S:'POP $P(PSJSYSL,"^",2,3)=ION_"^"_IO D HOME^%ZIS
- ;
- DONE ;
- I PSJACPF<10 K VADM,VAIN,VAIP
- K PSJACPF,PSGID,PSGOD,VA200,X
- Q
- HTWT(DFN) ; Get patient's height and weight from Vitals.
- S (PSJPWTD,PSJPHTD)=""
- ; IHS/CIA/PLS 12/11/03 Changed call to PCC Vitals
- ;S X="GMRVUTL" X ^%ZOSF("TEST") I S GMRVSTR="HT" D
- ;. D EN6^GMRVUTL S PSJPHT=$P(X,U,8) S:PSJPHT PSJPHT=$J(2.54*PSJPHT,0,2),PSJPHTD="("_$S($D(PSJY2K):$E($$ENDTC2^PSGMI($P(X,U)),1,10),1:$E($$ENDTC^PSGMI($P(X,U)),1,8))_")"
- ;. S GMRVSTR="WT" D EN6^GMRVUTL S PSJPWT=$P(X,U,8) S:PSJPWT PSJPWT=$J(PSJPWT/2.2,0,2),PSJPWTD="("_$S($D(PSJY2K):$E($$ENDTC2^PSGMI($P(X,U)),1,10),1:$E($$ENDTC^PSGMI($P(X,U)),1,8))_")"
- S X=$$VITALF^APSPFUNC(DFN,"WT"),PSJPWT=$$VITCWT^APSPFUNC($P(X,U,8)),PSJPWTD=$P(X,U)
- S X=$$VITALF^APSPFUNC(DFN,"HT"),PSJPHT=$$VITCHT^APSPFUNC($P(X,U,8)),PSJPHTD=$P(X,U)
- F X="PSJPWT","PSJPHT" S:'$G(@X) @X="______"
- F X="PSJPWTD","PSJPHTD" S:$G(@X)="" @X="(________)"
- Q
- PSJAC2(PSJY2K) ;
- D PSJAC Q
- PSJAC ;BIR/CML3-INPATIENT INFORMATION ;29-May-2012 14:37;PLS
- +1 ;;5.0; INPATIENT MEDICATIONS ;**8,10,50,127,1015**;16 DEC 97;Build 62
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA# 2191.
- +4 ; Modified - IHS/CIA/PLS - 12/11/03 - Line HTWT+2
- +5 SET DFN=PSGP
- SET PSJACPF=1
- GOTO CHK
- +6 ;
- ENBOTH ;
- +1 SET PSJACPF=11
- GOTO CHK
- +2 ;
- ENIV ;
- +1 NEW I,J,JJ,ON,PSJRBXX,X,X1,X2,X,Y
- SET PSJACPF=10
- SET PSGP=DFN
- +2 ;
- CHK ;
- +1 ;Check if 5.0 order conversion should be run for the selected patient.
- +2 ;I '$P($G(^PS(55,DFN,5.1)),U,11) D CONVERT^PSJUTL1(DFN,$S($E(IOST,1)="C":1,1:0))
- +3 ;/Commented out in PSJ*5*50. No longer needed
- +4 ;/F S PSJRBXX=$$OTF^OR3CONV(DFN,$S($E(IOST,1)="C":0,1:1)) Q:+PSJRBXX'<0 D
- +5 ;/.I +PSJRBXX=-1 W:$E(IOST,1)="C" !,$P(PSJRBXX,"^",2) H 4
- +6 ;Converting IV order to new OI with POE if not done so when installed PSJ*5*50
- +7 DO CNIV^PSJUTL1(DFN)
- +8 ;I $D(^PS(55,DFN,0)),'$P($G(^PS(55,DFN,0)),U,6) D EN^PSOHLUP(DFN)
- +9 SET VA200=1
- DO INP^VADPT
- +10 IF VAIN(4)
- IF PSJACPF#2
- SET PSJPCAF=1_"^"_VAIN(1)
- SET PSJPWD=+VAIN(4)
- SET PSJPWDN=$PIECE(VAIN(4),"^",2)
- SET PSJPTS=+VAIN(3)
- SET PSJPTSP=+VAIN(2)
- SET PSJPRB=VAIN(5)
- SET PSJPAD=+VAIN(7)
- SET PSJPDX=VAIN(9)
- SET PSJPTD=$SELECT($DATA(^PS(55,PSGP,5.1)):$PIECE(^(5.1),"^",4),1:"")
- SET PSJPDD=""
- GOTO CNV
- +11 SET VAIP("D")="L"
- DO IN5^VADPT
- IF PSJACPF[0
- GOTO CNV
- +12 SET PSJPCAF=""
- SET PSJPAD=+VAIP(13,1)
- +13 SET PSGID=+VAIP(3)
- SET X=+VAIP(4)=12!(+VAIP(4)=38)
- SET PSJPWD=+VAIP(5)
- SET PSJPWDN=$PIECE(VAIP(5),"^",2)
- SET PSJPRB=$PIECE(VAIP(6),"^",2)
- SET PSJPTSP=+VAIP(7)
- SET PSJPTS=+VAIP(8)
- SET PSJPDX=VAIP(9)
- SET PSJPTD=""
- SET PSJPDD=PSGID_"^"_$$ENDTC^PSGMI(PSGID)
- IF X
- SET PSJPDD=PSJPDD_"^1"
- +14 ;
- CNV ;
- +1 DO DEM^VADPT
- DO HTWT(PSGP)
- +2 IF PSJACPF#2
- SET PSGP(0)=VADM(1)
- SET PSJPSSN=VADM(2)
- SET PSJPDOB=+VADM(3)
- SET PSJPAGE=VADM(4)
- SET PSJPSEX=$SELECT(VADM(5)]"":VADM(5),1:"?^____")
- SET PSJPPID=VA("PID")
- SET PSJPBID=VA("BID")
- +3 IF PSJACPF#2
- Begin DoDot:1
- +4 IF $DATA(PSJY2K)
- Begin DoDot:2
- +5 FOR X="PSJPAD","PSJPDOB","PSJPTD"
- IF @X
- SET $PIECE(@X,"^",2)=$$ENDTC2^PSGMI(+@X)
- End DoDot:2
- QUIT
- +6 FOR X="PSJPAD","PSJPDOB","PSJPTD"
- IF @X
- SET $PIECE(@X,"^",2)=$$ENDTC^PSGMI(+@X)
- End DoDot:1
- +7 ;
- WP ; ward parameters
- +1 IF $DATA(PSJACNWP)
- GOTO DONE
- SET PSJSYSW0=""
- SET PSJSYSW=0
- IF $GET(PSJPWD)
- SET PSJSYSW=+$ORDER(^PS(59.6,"B",PSJPWD,0))
- IF PSJSYSW
- SET PSJSYSW0=$GET(^PS(59.6,PSJSYSW,0))
- +2 ;S PSJSYSL="",X=$P(PSJSYSU,";",3)>1 S PSJSYSL=$P(PSJSYSW0,"^",X*4+12) G:$D(PSJACND) DONE
- +3 SET PSJSYSL=""
- SET X=$PIECE(PSJSYSU,";",3)>1
- SET PSJSYSL=$SELECT(X=0:$PIECE(PSJSYSW0,"^",12),1:$PIECE(PSJSYSW0,"^",16))
- IF $DATA(PSJACND)
- GOTO DONE
- +4 IF PSJSYSL
- Begin DoDot:1
- +5 IF X
- SET X='$PIECE($GET(PSJSYSP0),"^",10)
- SET IOP=$SELECT($PIECE($GET(PSJSYSP0),"^",13)]"":$PIECE($GET(PSJSYSP0),"^",13),$PIECE(PSJSYSW0,"^",19+X)]"":$PIECE(PSJSYSW0,"^",19+X),1:"")
- IF IOP]""
- Begin DoDot:2
- +6 SET IOP="`"_IOP
- KILL %ZIS
- SET %ZIS="NQ"
- DO ^%ZIS
- IF 'POP
- SET $PIECE(PSJSYSL,"^",2,3)=ION_"^"_IO
- DO HOME^%ZIS
- End DoDot:2
- End DoDot:1
- +7 ;
- DONE ;
- +1 IF PSJACPF<10
- KILL VADM,VAIN,VAIP
- +2 KILL PSJACPF,PSGID,PSGOD,VA200,X
- +3 QUIT
- HTWT(DFN) ; Get patient's height and weight from Vitals.
- +1 SET (PSJPWTD,PSJPHTD)=""
- +2 ; IHS/CIA/PLS 12/11/03 Changed call to PCC Vitals
- +3 ;S X="GMRVUTL" X ^%ZOSF("TEST") I S GMRVSTR="HT" D
- +4 ;. D EN6^GMRVUTL S PSJPHT=$P(X,U,8) S:PSJPHT PSJPHT=$J(2.54*PSJPHT,0,2),PSJPHTD="("_$S($D(PSJY2K):$E($$ENDTC2^PSGMI($P(X,U)),1,10),1:$E($$ENDTC^PSGMI($P(X,U)),1,8))_")"
- +5 ;. S GMRVSTR="WT" D EN6^GMRVUTL S PSJPWT=$P(X,U,8) S:PSJPWT PSJPWT=$J(PSJPWT/2.2,0,2),PSJPWTD="("_$S($D(PSJY2K):$E($$ENDTC2^PSGMI($P(X,U)),1,10),1:$E($$ENDTC^PSGMI($P(X,U)),1,8))_")"
- +6 SET X=$$VITALF^APSPFUNC(DFN,"WT")
- SET PSJPWT=$$VITCWT^APSPFUNC($PIECE(X,U,8))
- SET PSJPWTD=$PIECE(X,U)
- +7 SET X=$$VITALF^APSPFUNC(DFN,"HT")
- SET PSJPHT=$$VITCHT^APSPFUNC($PIECE(X,U,8))
- SET PSJPHTD=$PIECE(X,U)
- +8 FOR X="PSJPWT","PSJPHT"
- IF '$GET(@X)
- SET @X="______"
- +9 FOR X="PSJPWTD","PSJPHTD"
- IF $GET(@X)=""
- SET @X="(________)"
- +10 QUIT
- PSJAC2(PSJY2K) ;
- +1 DO PSJAC
- QUIT
