PSIVMAN1 ;BIR/RGY,PR-COMPILE MAN LIST ;05-Dec-2003 10:01;PLS
;;5.0; INPATIENT MEDICATIONS ;**81**;16 DEC 97
;
; Reference to ^PS(55 is supported by DBIA# 2191.
; Reference to ^PS(52.6 is supported by DBIA# 1231.
; Reference to ^PS(52.7 is supported by DBIA# 2173.
;
; Modified - IHS/CIA/PLS - 12/05/03 - Line PAT
PRNTO ;
G:$S('$D(^PS(55,DFN,"IV",ON,"AD",0)):1,$P(^(0),"^",4)<1:1,1:0) SOL
F PSIVA=0:0 S PSIVA=$O(^PS(55,DFN,"IV",ON,"AD",PSIVA)) Q:'PSIVA S PSIVA=PSIVA_"^"_^(PSIVA,0) W !?16,$P(^PS(52.6,$P(PSIVA,"^",2),0),"^")," ",$P(PSIVA,"^",3) W:$P(PSIVA,"^",4)]"" " in bottle(s): ",$P(PSIVA,"^",4) W ?80,"Lot#: __________"
SOL W:$E(PSIVDN,1,3)="***" !?16,"in",!?16,PSIVDN
G:$S('$D(^PS(55,DFN,"IV",ON,"SOL",0)):1,$P(^(0),"^",4)<1:1,1:0) PAT
W !?16,"in" F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IV",ON,"SOL",PSIV)) Q:'PSIV S PSIV=PSIV_"^"_^(PSIV,0) D
.S PSIVSL=$S($D(^PS(52.7,$P(PSIV,"^",2),0)):$P(^(0),"^")_" "_$P(PSIV,"^",3)_" "_$P(^(0),"^",4),1:"*** Undefined Solution") W !?16,PSIVSL W:$E(PSIVSL,1,3)'="***" ?80,"Lot#: __________"
;
; IHS/CIA/PLS - 12/05/03 - Commented out next line and changed from SSN to HRN
PAT ;W !?4,"[",ON,"] ",?10,VADM(1)," (",$E(VADM(2),6,9),") (",$S(+VAIN(4):$P(VAIN(4),U,2),1:"Outpatient IV"),")",?62,+^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,PSIV2,DFN,ON) S TOTAL=TOTAL+^(ON)
W !?4,"[",ON,"] ",?10,VADM(1)," (",$G(PSJPBID),") (",$S(+VAIN(4):$P(VAIN(4),U,2),1:"Outpatient IV"),")",?62,+^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,PSIV2,DFN,ON) S TOTAL=TOTAL+^(ON)
I P(4)="S"!(P(23)="S") W ?75," Syringe size: ",$S($D(^PS(55,DFN,"IV",ON,2)):$S($P(^(2),U,4)'="":$P(^(2),U,4),1:"NF"),1:"NF")
S PSIV=$S($D(^PS(55,DFN,"IV",ON,3)):$P(^(3),"^"),1:"") W:PSIV]"" !?10,"Other Info.: ",PSIV S PSIV=$S($D(^(1)):$P(^(1),"^"),1:"") W:PSIV]"" !?14,"Remarks: ",$P(^(1),"^")
W ! K PSIVA,PSIV3,PSIV Q
ENT ; will print man. list
S NOFLG=0
I '$D(^PS(55,PSIVGL1,PSIVSN,PSIVGL2)) S NOFLG=1,PSIVT=$G(PSIVTTM) D HDR Q
S PSIVT="",TOTAL=0
F JJ=0:0 S PSIVT=$O(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT)) D:TOTAL>0 TOTAL Q:PSIVT="" D HDR S PSIV1="" F JJ1=0:0 S PSIV1=$O(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1)) Q:PSIV1="" S PSIVDN=PSIV1 D:PSIVDN["^"!(PSIVDN["zz") LOOKUP D RGY1
K PSIVT,PSIV1,PSIV2,PSIVTEST,PSIVDN,FILE Q
LOOKUP ; expand drug info
I PSIVDN?1"zz"1N S PSIVDN="*** No "_$S(PSIVDN["6":"Additive",1:"Solution") Q
S FILE=+("52."_+$P(PSIVDN,"^",3)),DA=$P(PSIVDN,";",2)
I $D(^PS(FILE,DA,0)),$P(^(0),"^")]"" S PSIVDN=$P(^(0),"^")_" "_$P(PSIVDN,"^",2)_$S(FILE[7:" "_$P(^(0),"^",4),1:"")
Q
;
RGY ;
F DFN=0:0 S DFN=$O(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,PSIV2,DFN)) Q:'DFN D ENIV^PSJAC F ON=0:0 S ON=$O(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,PSIV2,DFN,ON)) Q:'ON D SETP,PRNTO
Q
SETP S Y=^PS(55,DFN,"IV",ON,0) F X=1:1:23 S P(X)=$P(Y,"^",X)
Q
WD X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) Q
HDR W:$Y @IOF W !,"MANUFACTURING LIST F" I '$D(PSIVOD) W "ROM SUSPENSE"
E W "OR IV ROOM: ",$P(^PS(59.5,PSIVSN,0),U)," AT " S Y=PSIVDT X ^DD("DD") W $P(Y,"@")
W !,"Printed on",?30,": "
D NOW^%DTC S Y=$E(%,1,12) K %I,%H,%
D WD G:'$D(PSIVOD) HDRE
S X=$$CODES^PSIVUTL(PSIVT,55.01,.04) W !,X," manufacturing time: " S Y=PSIVMT(PSIVT) D WD W !!,X,"S covering from " S Y=PSIVOD(PSIVT) D WD W " to " S Y=PSIVCD(PSIVT) D WD
I NOFLG=1 W ! D DESC^PSIVLBL1(PSIVT)
Q:NOFLG=1 W !!?20,"Order",?60,"Totals",?80,"Lot #'s"
HDRE W ! F X=1:1:IOM-1 W "-"
W ! S X=$$CODES^PSIVUTL(PSIVT,55.01,.04) W:X]"" !,"*** ",X,"S ***",!
Q
RGY1 W !,PSIVDN,?55,"Total: ",^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,0) W:$E(PSIVDN,1,3)="***" !?16,PSIVDN
S PSIV2="" F JJ=0:0 S PSIV2=$O(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,PSIV2)) Q:PSIV2="" S PSIVDN=PSIV2 D:PSIVDN["^"!(PSIVDN["zz") LOOKUP D RGY
;
Q
TOTAL W !?60,"_______",!?47,"Overall Total: ",TOTAL S TOTAL=0 Q
PSIVMAN1 ;BIR/RGY,PR-COMPILE MAN LIST ;05-Dec-2003 10:01;PLS
+1 ;;5.0; INPATIENT MEDICATIONS ;**81**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA# 2191.
+4 ; Reference to ^PS(52.6 is supported by DBIA# 1231.
+5 ; Reference to ^PS(52.7 is supported by DBIA# 2173.
+6 ;
+7 ; Modified - IHS/CIA/PLS - 12/05/03 - Line PAT
PRNTO ;
+1 IF $SELECT('$DATA(^PS(55,DFN,"IV",ON,"AD",0))
GOTO SOL
+2 FOR PSIVA=0:0
SET PSIVA=$ORDER(^PS(55,DFN,"IV",ON,"AD",PSIVA))
IF 'PSIVA
QUIT
SET PSIVA=PSIVA_"^"_^(PSIVA,0)
WRITE !?16,$PIECE(^PS(52.6,$PIECE(PSIVA,"^",2),0),"^")," ",$PIECE(PSIVA,"^",3)
IF $PIECE(PSIVA,"^",4)]""
WRITE " in bottle(s): ",$PIECE(PSIVA,"^",4)
WRITE ?80,"Lot#: __________"
SOL IF $EXTRACT(PSIVDN,1,3)="***"
WRITE !?16,"in",!?16,PSIVDN
+1 IF $SELECT('$DATA(^PS(55,DFN,"IV",ON,"SOL",0))
GOTO PAT
+2 WRITE !?16,"in"
FOR PSIV=0:0
SET PSIV=$ORDER(^PS(55,DFN,"IV",ON,"SOL",PSIV))
IF 'PSIV
QUIT
SET PSIV=PSIV_"^"_^(PSIV,0)
Begin DoDot:1
+3 SET PSIVSL=$SELECT($DATA(^PS(52.7,$PIECE(PSIV,"^",2),0)):$PIECE(^(0),"^")_" "_$PIECE(PSIV,"^",3)_" "_$PIECE(^(0),"^",4),1:"*** Undefined Solution")
WRITE !?16,PSIVSL
IF $EXTRACT(PSIVSL,1,3)'="***"
WRITE ?80,"Lot#: __________"
End DoDot:1
+4 ;
+5 ; IHS/CIA/PLS - 12/05/03 - Commented out next line and changed from SSN to HRN
PAT ;W !?4,"[",ON,"] ",?10,VADM(1)," (",$E(VADM(2),6,9),") (",$S(+VAIN(4):$P(VAIN(4),U,2),1:"Outpatient IV"),")",?62,+^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,PSIV2,DFN,ON) S TOTAL=TOTAL+^(ON)
+1 WRITE !?4,"[",ON,"] ",?10,VADM(1)," (",$GET(PSJPBID),") (",$SELECT(+VAIN(4):$PIECE(VAIN(4),U,2),1:"Outpatient IV"),")",?62,+^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,PSIV2,DFN,ON)
SET TOTAL=TOTAL+^(ON)
+2 IF P(4)="S"!(P(23)="S")
WRITE ?75," Syringe size: ",$SELECT($DATA(^PS(55,DFN,"IV",ON,2)):$SELECT($PIECE(^(2),U,4)'="":$PIECE(^(2),U,4),1:"NF"),1:"NF")
+3 SET PSIV=$SELECT($DATA(^PS(55,DFN,"IV",ON,3)):$PIECE(^(3),"^"),1:"")
IF PSIV]""
WRITE !?10,"Other Info.: ",PSIV
SET PSIV=$SELECT($DATA(^(1)):$PIECE(^(1),"^"),1:"")
IF PSIV]""
WRITE !?14,"Remarks: ",$PIECE(^(1),"^")
+4 WRITE !
KILL PSIVA,PSIV3,PSIV
QUIT
ENT ; will print man. list
+1 SET NOFLG=0
+2 IF '$DATA(^PS(55,PSIVGL1,PSIVSN,PSIVGL2))
SET NOFLG=1
SET PSIVT=$GET(PSIVTTM)
DO HDR
QUIT
+3 SET PSIVT=""
SET TOTAL=0
+4 FOR JJ=0:0
SET PSIVT=$ORDER(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT))
IF TOTAL>0
DO TOTAL
IF PSIVT=""
QUIT
DO HDR
SET PSIV1=""
FOR JJ1=0:0
SET PSIV1=$ORDER(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1))
IF PSIV1=""
QUIT
SET PSIVDN=PSIV1
IF PSIVDN["^"!(PSIVDN["zz")
DO LOOKUP
DO RGY1
+5 KILL PSIVT,PSIV1,PSIV2,PSIVTEST,PSIVDN,FILE
QUIT
LOOKUP ; expand drug info
+1 IF PSIVDN?1"zz"1N
SET PSIVDN="*** No "_$SELECT(PSIVDN["6":"Additive",1:"Solution")
QUIT
+2 SET FILE=+("52."_+$PIECE(PSIVDN,"^",3))
SET DA=$PIECE(PSIVDN,";",2)
+3 IF $DATA(^PS(FILE,DA,0))
IF $PIECE(^(0),"^")]""
SET PSIVDN=$PIECE(^(0),"^")_" "_$PIECE(PSIVDN,"^",2)_$SELECT(FILE[7:" "_$PIECE(^(0),"^",4),1:"")
+4 QUIT
+5 ;
RGY ;
+1 FOR DFN=0:0
SET DFN=$ORDER(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,PSIV2,DFN))
IF 'DFN
QUIT
DO ENIV^PSJAC
FOR ON=0:0
SET ON=$ORDER(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,PSIV2,DFN,ON))
IF 'ON
QUIT
DO SETP
DO PRNTO
+2 QUIT
SETP SET Y=^PS(55,DFN,"IV",ON,0)
FOR X=1:1:23
SET P(X)=$PIECE(Y,"^",X)
+1 QUIT
WD XECUTE ^DD("DD")
WRITE $PIECE(Y,"@")," ",$PIECE(Y,"@",2)
QUIT
HDR IF $Y
WRITE @IOF
WRITE !,"MANUFACTURING LIST F"
IF '$DATA(PSIVOD)
WRITE "ROM SUSPENSE"
+1 IF '$TEST
WRITE "OR IV ROOM: ",$PIECE(^PS(59.5,PSIVSN,0),U)," AT "
SET Y=PSIVDT
XECUTE ^DD("DD")
WRITE $PIECE(Y,"@")
+2 WRITE !,"Printed on",?30,": "
+3 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
KILL %I,%H,%
+4 DO WD
IF '$DATA(PSIVOD)
GOTO HDRE
+5 SET X=$$CODES^PSIVUTL(PSIVT,55.01,.04)
WRITE !,X," manufacturing time: "
SET Y=PSIVMT(PSIVT)
DO WD
WRITE !!,X,"S covering from "
SET Y=PSIVOD(PSIVT)
DO WD
WRITE " to "
SET Y=PSIVCD(PSIVT)
DO WD
+6 IF NOFLG=1
WRITE !
DO DESC^PSIVLBL1(PSIVT)
+7 IF NOFLG=1
QUIT
WRITE !!?20,"Order",?60,"Totals",?80,"Lot #'s"
HDRE WRITE !
FOR X=1:1:IOM-1
WRITE "-"
+1 WRITE !
SET X=$$CODES^PSIVUTL(PSIVT,55.01,.04)
IF X]""
WRITE !,"*** ",X,"S ***",!
+2 QUIT
RGY1 WRITE !,PSIVDN,?55,"Total: ",^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,0)
IF $EXTRACT(PSIVDN,1,3)="***"
WRITE !?16,PSIVDN
+1 SET PSIV2=""
FOR JJ=0:0
SET PSIV2=$ORDER(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,PSIVT,PSIV1,PSIV2))
IF PSIV2=""
QUIT
SET PSIVDN=PSIV2
IF PSIVDN["^"!(PSIVDN["zz")
DO LOOKUP
DO RGY
+2 ;
+3 QUIT
TOTAL WRITE !?60,"_______",!?47,"Overall Total: ",TOTAL
SET TOTAL=0
QUIT
