- PSIVMAN1 ;BIR/RGY,PR-COMPILE MAN LIST ;07 OCT 97 / 9:35 AM
- ;;5.0;INPATIENT MEDICATIONS;**81,364,425**;16 DEC 97;Build 3
- ;
- ; 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.
- 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) D
- .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#: __________"
- .;*364 introduces haz handle/dispose warnings-bg ;*425 removing carriage returns
- .N PSDA,PSHAZD S PSDA=$P($G(^PS(52.6,$P(PSIVA,U,2),0)),U,11) S PSHAZD=$$HAZ^PSSUTIL(PSDA,"OI")
- .I $P(PSHAZD,"^")!$P(PSHAZD,"^",2) W ! W:$P(PSHAZD,"^") ?16,"<<HAZ Handle>>" W:$P(PSHAZD,"^",2) ?15," <<HAZ Dispose>>"
- ;
- 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#: __________"
- .;*364 introduces haz handle/dispose warnings-bg ;*425 removing carriage returns
- .N PSSOL,PSHAZS S PSSOL=$P(^PS(52.7,$P(PSIV,U,2),0),U,11) S PSHAZS=$$HAZ^PSSUTIL(PSSOL,"OI")
- .I $P(PSHAZS,"^")!$P(PSHAZS,"^",2) W ! W:$P(PSHAZS,"^") ?16,"<<HAZ Handle>>" W:$P(PSHAZS,"^",2) ?15," <<HAZ Dispose>>"
- ;
- 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)
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVMAN1 4138 printed Apr 23, 2025@18:18:54 Page 2
- PSIVMAN1 ;BIR/RGY,PR-COMPILE MAN LIST ;07 OCT 97 / 9:35 AM
- +1 ;;5.0;INPATIENT MEDICATIONS;**81,364,425**;16 DEC 97;Build 3
- +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.
- 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)
- Begin DoDot:1
- +3 WRITE !?16,$PIECE(^PS(52.6,$PIECE(PSIVA,"^",2),0),"^")," ",$PIECE(PSIVA,"^",3)
- +4 if $PIECE(PSIVA,"^",4)]""
- WRITE " in bottle(s): ",$PIECE(PSIVA,"^",4)
- WRITE ?80,"Lot#: __________"
- +5 ;*364 introduces haz handle/dispose warnings-bg ;*425 removing carriage returns
- +6 NEW PSDA,PSHAZD
- SET PSDA=$PIECE($GET(^PS(52.6,$PIECE(PSIVA,U,2),0)),U,11)
- SET PSHAZD=$$HAZ^PSSUTIL(PSDA,"OI")
- +7 IF $PIECE(PSHAZD,"^")!$PIECE(PSHAZD,"^",2)
- WRITE !
- if $PIECE(PSHAZD,"^")
- WRITE ?16,"<<HAZ Handle>>"
- if $PIECE(PSHAZD,"^",2)
- WRITE ?15," <<HAZ Dispose>>"
- End DoDot:1
- +8 ;
- 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
- +4 if $EXTRACT(PSIVSL,1,3)'="***"
- WRITE ?80,"Lot#: __________"
- +5 ;*364 introduces haz handle/dispose warnings-bg ;*425 removing carriage returns
- +6 NEW PSSOL,PSHAZS
- SET PSSOL=$PIECE(^PS(52.7,$PIECE(PSIV,U,2),0),U,11)
- SET PSHAZS=$$HAZ^PSSUTIL(PSSOL,"OI")
- +7 IF $PIECE(PSHAZS,"^")!$PIECE(PSHAZS,"^",2)
- WRITE !
- if $PIECE(PSHAZS,"^")
- WRITE ?16,"<<HAZ Handle>>"
- if $PIECE(PSHAZS,"^",2)
- WRITE ?15," <<HAZ Dispose>>"
- End DoDot:1
- +8 ;
- PAT WRITE !?4,"[",ON,"] ",?10,VADM(1)," (",$EXTRACT(VADM(2),6,9),") (",$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)
- +1 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")
- +2 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),"^")
- +3 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
