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
