PSGPLR ;BIR/CML3-PRINTS PICK LIST REPORT ; 6/15/07 1:12pm
;;5.0;INPATIENT MEDICATIONS;**10,50,67,119,129,191,317,364**;16 DEC 97;Build 47
;
; Reference to ^PS(55 is supported by DBIA# 2191.
; Reference to ^PS(59.7 is supported by DBIA# 2181.
; Reference to ^PSDRUG is supported by DBIA# 2192.
; Reference to ^%DTC is supported by DBIA# 10000.
; Reference to ^VADPT is supported by DBIA# 10061.
;
N PSGY,OLDWARD,STPDT D NOW^%DTC S PSGDT=+$E(%,1,12),PPLD=$$ENDTC^PSGMI(PSGDT),$P(OLINE,"-",75)="",PSGPLXR=$S($G(PSGPLUPF)=1:"AU",1:"AC")
S PGN=0,(FACL,LINE)="",$P(LINE,"-",81)="",$P(FACL,"_",31)="",TND=$G(^PS(53.5,PSGPLG,0)),PSD=$P(TND,"^",3),PFD=$P(TND,"^",4),WSF=$P(TND,"^",7),WGPN=$S('$D(^PS(57.5,PSGPLWG,0)):"N/F",$P(^(0),"^")]"":$P(^(0),"^"),1:"N/F")
S FFF=$S($P(PSGPLWGP,"^",4):2,$P(PSGPLWGP,"^",5):1,1:0),CML=IO'=IO(0)!($E(IOST,1,2)'="C-")
F X="PSD","PFD" S @X=$$ENDTC^PSGMI(@X)
U IO
I '$D(^PS(53.5,$S($D(PSGPLUPF):"AU",1:"AC"),PSGPLG)) S NPLF=0 D HEADER W !!?25,"*** No orders to fill ***" W:(IO'=IO(0)!(IOST'["C-"))&($Y) @IOF G DONE
;
BEGIN ;
I '$$LOCK^PSGPLUTL(PSGPLG,"PSGPLR") H 60 G BEGIN
S NPLF=1,TM=0 F S TM=$O(^PS(53.5,PSGPLXR,PSGPLG,TM)) Q:TM=""!(TM["~") S (DDRG,PDRG,PN,PST,RM,WDN)="" D HEADER:'FFF,^PSGPLR0 I CML,'FFF D PAGECK W !!?25,"FILLED BY: ",FACL,!!?25,"CHECKED BY: ",FACL
I CML,FFF D PAGECK W !!?25,"FILLED BY: ",FACL,!!?25,"CHECKED BY: ",FACL W:$Y @IOF
;
DONE ;
D UNLOCK^PSGPLUTL(PSGPLG,"PSGPLR")
K AT,ATC,CML,DDRG,DIS,DND,DO,DR,DRN,DRG,FACL,FD,FFF,FQC,LINE,ND,ND0,ND1,ND2,ND6,NEED,NPLF,OLINE,PSGPLDC,PSGPLXR,PSGPLXRX
K PSJJORD,PSJORDN,PFD,PGN,PN,POP,PPLD,PPN,PRM,PSD,PSGID,PSGOD,PSGP,PST,PW,RM,RTE,SCH,SD,SM,PSSN,TD,TM,TND,WDN,WL,WG,WSF,WGPN,X
Q
;
DD ;
N PSJRNW,CNT,PADE
I $D(PSGPLREN("B",$G(PSGP),$G(PSJJORD))),$G(PSGPLUP) D
.N OSTOP,DRGND S (DDRG,OLDWARD)="" S DRGND=$O(PSGPLREN("B",PSGP,PSJJORD,0)) Q:'DRGND S OSTOP=PSGPLREN("B",PSGP,PSJJORD,DRGND) Q:'OSTOP
.N ST,TMPDRG S CNT=0,ST=$P(ND0,"^",7) S TMPDRG=0 S TMPDRG=$O(PSGPLREN("B",PSGP,PSJJORD,TMPDRG)) S TMPDRG=$P(DRG,"^")_"^"_TMPDRG
.F PSGPLXRX="AU","AC" Q:CNT F I=0:1 S DDRG=$O(PSGPLREN(53.5,PSGPLXRX,PSGPLG,TM,WDN,RM,PN,PST,TMPDRG,DDRG)) Q:(DDRG="")!(DDRG="NO DISPENSE DRUG") D
..S X=$G(PSGPLREN(53.5,PSGPLG,1,PSGP,1,+DRGND,1,$P(DDRG,"^",2),0)) S DR=+X,DND=$P(X,U,2,4) Q:'X
..S DRN=$G(^PS(55,PSGP,5,PSJJORD,1,DR,0)),DR=$$ENDDN^PSGMI($P(DRN,"^")) I DND?7N1"DI" S DND=$E($$ENDTC^PSGMI(+DND),1,8)
..S DIS=$P(DND,"^",2),NEED=$S($P(DND,"^")]"":$P(DND,"^"),1:0)
..;GMZ;PSJ*5*191;Allow for Multiple Dispensed Drug units needed
..S PSJRNW(I)=1_"^"_+NEED
..Q
.K PSGPLREN("B",PSGP,PSJJORD),PSGPLREN(53.5,PSGPLG,1,PSGP,1,+DRGND) W !!
;
S CNT=0
S (DDRG,OLDWARD)="" N ST S ST=$P(ND0,"^",7) F S DDRG=$O(^PS(53.5,PSGPLXR,PSGPLG,TM,WDN,RM,PN,PST,DRG,DDRG)) Q:(DDRG="")!(DDRG="NO DISPENSE DRUG") S X=$G(^PS(53.5,PSGPLG,1,+$P(PN,U,2),1,+$P(DRG,U,2),1,+$P(DDRG,U,2),0)),DR=+X,DND=$P(X,U,2,4) D
.S DRN=$G(^PS(55,PSGP,5,PSJJORD,1,DR,0)),DR=$$ENDDN^PSGMI($P(DRN,"^")) I DND?7N1"DI" S DND=$E($$ENDTC^PSGMI(+DND),1,8) W !?6,DR,?48,ST,?51,"(DI "_DND_")",?66,"Returns: ____" Q
.S UD=$P(DRN,"^",2),ATC=$P($G(^PSDRUG(+DRN,8.5)),"^",2)]"" S:ATC ATC=$D(^(212,"AC",PSGPLWG))
.S DIS=$P(DND,"^",2),NEED=$S($P(DND,"^")]"":$P(DND,"^"),1:0) I ATC S ATCFF=+$P($G(^PS(59.7,1,26)),"^",7),ATC=$S(ATCFF:NEED,UD#1:0,DIS]"":+DIS,1:NEED) I ATC,$S(ATC<1:1,ATC'?1.3N:1,1:ATC#1) S ATC=0
.I ATC S X=0,X=$O(^PS(59.7,X)) I $P($G(^(X,26)),U,2)=1,PST="OC" S ATC=0
.S UD=$S('UD:1,UD=.5:"1/2",UD=.25:"1/4",UD<1:"0"_UD,1:UD)
.I $D(PSJRNW) D
..I 'CNT W !?35,"**** RENEWAL ****"
..S NEED=NEED-$P(PSJRNW(CNT),"^",2) S:NEED<0 NEED=0 S CNT=CNT+1
.N TMPORD S TMPORD=PSJJORD_"U" S PADE=$S($$DRGSTOCK^PSJPADSI(PSGP,TMPORD,,,+$G(DRN)):"PADE",1:"")
.W !,DR_" ("_+DRN_")",?48,ST,?52,PADE W:(ATC)&(NEED>0) ?57,"ATC" W ?61,$J(UD,4),?68,$J(NEED,4),?75,$S(DIS]"":$J(DIS,4),1:"____")
.;introduces hazardous to handle/dispose warnings *364
.K PSHAZ N PSHAZ S PSHAZ=$$HAZ^PSSUTIL(+DRN) I $P(PSHAZ,"^")=1 W !,"<<HAZ Handle>>"
.I $P(PSHAZ,"^",2)=1 W " <<HAZ Dispose>>"
.S:ST="DISCONTINUED" OLDWARD=1 S ST=""
I DDRG="NO DISPENSE DRUG" W !?6,PDRG,?48,ST,?57,"OI" S:ST="DISCONTINUED" OLDWARD=1 S ST=""
N GIVSTR S GIVSTR=$S(DO]"":DO_" ",1:"")_RTE_" "_SCH D
.N MARX,I,Y,X D TXT^PSGMUTL(GIVSTR,60)
.F I=1:1:MARX W:I=1 !?10,"Give: ",MARX(1) W:I>1 !?16,MARX(I)
D:OLDWARD WARDCHK W:AT]"" !,?65-$L(AT),AT W !?7,"Start: ",SD,?37,"Stop: ",FD
I Y]"" W !?10 F Q=1:1:$L(Y," ") S X=$P(Y," ",Q) W:$X+$L(X)>65 !?10 W X_" "
K ST
Q
;
EXDD ;
W ! S (DDRG,OLDWARD)="" F S DDRG=$O(^PS(53.5,PSGPLXR,PSGPLG,TM,WDN,RM,PN,PST,DRG,DDRG)) Q:(DDRG="")!(DDRG="NO DISPENSE DRUG") S DND=^(DDRG) D
.S DR=$P(DDRG,"^",2),DRN=$G(^PS(55,PSGP,5,PSJJORD,1,DR,0)),ID=$P(DRN,"^",3),DR=$$ENDDN^PSGMI($P(DRN,"^")) W !?6,DR,?48,DIS,?66,"Returns: ____" S:DIS="DISCONTINUED" OLDWARD=1 S DIS=""
.K PSHAZ N PSHAZ,PSHAZH,PSHAZD S (PSHAZH,PSHAZD)=0 S PSHAZ=$$HAZ^PSSUTIL(+DRN) ;*364
.I $P(PSHAZ,"^")=1 S PSHAZH=1
.I $P(PSHAZ,"^",2)=1 S PSHAZD=1
.I (PSHAZH&PSHAZD) W !?6,"<<HAZ Handle>> <<HAZ Dispose>>"
.I (PSHAZH&'PSHAZD) W !?6,"<<HAZ Handle>>"
.I ('PSHAZH&PSHAZD) W !?6,"<<HAZ Dispose>>"
I DDRG="NO DISPENSE DRUG" S ND1=$G(^PS(55,PSGP,5,PSJJORD,.2)),PDRG=$$ENPDN^PSGMI($P(ND1,"^")) W !?6,PDRG,?48,DIS,?66,"Returns: ____" S:DIS="DISCONTINUED" OLDWARD=1 S DIS=""
W !?10,"Give: ",$S(DO]"":DO_" ",1:""),RTE," ",SCH D:OLDWARD WARDCHK W !?7,"Start: ",SD,?37,"Stop: ",FD
Q
;
FCL ;
I PGN,CML,$P(PSGPLWGP,"^",6) W !!?25,"FILLED BY: ",FACL,!!?25,"CHECKED BY: "_FACL
;
S PGN=PGN+1 W:$Y @IOF
W ?1,"(",PSGPLG,")",?$S($D(PSGPLUPF):27,1:32),"PICK LIST REPORT" W:$D(PSGPLUPF) " (UPDATE)" W ?64,PPLD,!,"Ward group: ",WGPN,?73-$L(PGN),"Page: ",PGN,!?18,"For ",PSD," through ",PFD W:NPLF !,"Team: ",$S(TM'["zz":TM,1:"** N/F **")
W !!,$S($P(TND,"^",6)&'$P(TND,"^",8):"Bed-Room",1:"Room-Bed"),?15,"Patient",?67,"Units",?74,"Units",!?9,"Medication",?48,"ST",?62,"U/D",?66,"Needed",?74,"Disp'd",!,LINE Q
;
PAGECK ;
S PSGPY=$Y,PSGPY=$Y+4 I PSGPY+4>IOSL W @IOF
Q
;
WARDCHK ; if patient has discontinued orders from a different ward, print the ward and room/bed that the orders were discontinued from.
Q:'$G(STPDT)
S VAINDT=$$MINUTES(STPDT,5)
S DFN=PSGP D INP^VADPT I PW'=$P(VAIN(4),"^",2) W ?48,$E("(from "_$P(VAIN(4),"^",2)_" "_VAIN(5)_")",1,31)
S OLDWARD="" Q
;
MINUTES(STPDT,LESS) ; pass in a FM date/time and the number of minutes (9 or less) to subtract from it
S VAINDT=$S($E(STPDT,9,12)<LESS:($E(STPDT,1,7)-1)_"."_(($E(STPDT,9,12)+2360)-LESS),$E(STPDT,11,12)<5:$E(STPDT,1,8)_$S($E(STPDT,9,10)="10":"09",$E(STPDT,9,10)="20":"19",1:$E(STPDT,9)_($E(STPDT,10)-1))_(60+$E(STPDT,12)-LESS),1:STPDT-(LESS*.0001))
Q VAINDT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGPLR 6789 printed Dec 13, 2024@02:02:53 Page 2
PSGPLR ;BIR/CML3-PRINTS PICK LIST REPORT ; 6/15/07 1:12pm
+1 ;;5.0;INPATIENT MEDICATIONS;**10,50,67,119,129,191,317,364**;16 DEC 97;Build 47
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA# 2191.
+4 ; Reference to ^PS(59.7 is supported by DBIA# 2181.
+5 ; Reference to ^PSDRUG is supported by DBIA# 2192.
+6 ; Reference to ^%DTC is supported by DBIA# 10000.
+7 ; Reference to ^VADPT is supported by DBIA# 10061.
+8 ;
+9 NEW PSGY,OLDWARD,STPDT
DO NOW^%DTC
SET PSGDT=+$EXTRACT(%,1,12)
SET PPLD=$$ENDTC^PSGMI(PSGDT)
SET $PIECE(OLINE,"-",75)=""
SET PSGPLXR=$SELECT($GET(PSGPLUPF)=1:"AU",1:"AC")
+10 SET PGN=0
SET (FACL,LINE)=""
SET $PIECE(LINE,"-",81)=""
SET $PIECE(FACL,"_",31)=""
SET TND=$GET(^PS(53.5,PSGPLG,0))
SET PSD=$PIECE(TND,"^",3)
SET PFD=$PIECE(TND,"^",4)
SET WSF=$PIECE(TND,"^",7)
SET WGPN=$SELECT('$DATA(^PS(57.5,PSGPLWG,0)):"N/F",$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:"N/F")
+11 SET FFF=$SELECT($PIECE(PSGPLWGP,"^",4):2,$PIECE(PSGPLWGP,"^",5):1,1:0)
SET CML=IO'=IO(0)!($EXTRACT(IOST,1,2)'="C-")
+12 FOR X="PSD","PFD"
SET @X=$$ENDTC^PSGMI(@X)
+13 USE IO
+14 IF '$DATA(^PS(53.5,$SELECT($DATA(PSGPLUPF):"AU",1:"AC"),PSGPLG))
SET NPLF=0
DO HEADER
WRITE !!?25,"*** No orders to fill ***"
if (IO'=IO(0)!(IOST'["C-"))&($Y)
WRITE @IOF
GOTO DONE
+15 ;
BEGIN ;
+1 IF '$$LOCK^PSGPLUTL(PSGPLG,"PSGPLR")
HANG 60
GOTO BEGIN
+2 SET NPLF=1
SET TM=0
FOR
SET TM=$ORDER(^PS(53.5,PSGPLXR,PSGPLG,TM))
if TM=""!(TM["~")
QUIT
SET (DDRG,PDRG,PN,PST,RM,WDN)=""
if 'FFF
DO HEADER
DO ^PSGPLR0
IF CML
IF 'FFF
DO PAGECK
WRITE !!?25,"FILLED BY: ",FACL,!!?25,"CHECKED BY: ",FACL
+3 IF CML
IF FFF
DO PAGECK
WRITE !!?25,"FILLED BY: ",FACL,!!?25,"CHECKED BY: ",FACL
if $Y
WRITE @IOF
+4 ;
DONE ;
+1 DO UNLOCK^PSGPLUTL(PSGPLG,"PSGPLR")
+2 KILL AT,ATC,CML,DDRG,DIS,DND,DO,DR,DRN,DRG,FACL,FD,FFF,FQC,LINE,ND,ND0,ND1,ND2,ND6,NEED,NPLF,OLINE,PSGPLDC,PSGPLXR,PSGPLXRX
+3 KILL PSJJORD,PSJORDN,PFD,PGN,PN,POP,PPLD,PPN,PRM,PSD,PSGID,PSGOD,PSGP,PST,PW,RM,RTE,SCH,SD,SM,PSSN,TD,TM,TND,WDN,WL,WG,WSF,WGPN,X
+4 QUIT
+5 ;
DD ;
+1 NEW PSJRNW,CNT,PADE
+2 IF $DATA(PSGPLREN("B",$GET(PSGP),$GET(PSJJORD)))
IF $GET(PSGPLUP)
Begin DoDot:1
+3 NEW OSTOP,DRGND
SET (DDRG,OLDWARD)=""
SET DRGND=$ORDER(PSGPLREN("B",PSGP,PSJJORD,0))
if 'DRGND
QUIT
SET OSTOP=PSGPLREN("B",PSGP,PSJJORD,DRGND)
if 'OSTOP
QUIT
+4 NEW ST,TMPDRG
SET CNT=0
SET ST=$PIECE(ND0,"^",7)
SET TMPDRG=0
SET TMPDRG=$ORDER(PSGPLREN("B",PSGP,PSJJORD,TMPDRG))
SET TMPDRG=$PIECE(DRG,"^")_"^"_TMPDRG
+5 FOR PSGPLXRX="AU","AC"
if CNT
QUIT
FOR I=0:1
SET DDRG=$ORDER(PSGPLREN(53.5,PSGPLXRX,PSGPLG,TM,WDN,RM,PN,PST,TMPDRG,DDRG))
if (DDRG="")!(DDRG="NO DISPENSE DRUG")
QUIT
Begin DoDot:2
+6 SET X=$GET(PSGPLREN(53.5,PSGPLG,1,PSGP,1,+DRGND,1,$PIECE(DDRG,"^",2),0))
SET DR=+X
SET DND=$PIECE(X,U,2,4)
if 'X
QUIT
+7 SET DRN=$GET(^PS(55,PSGP,5,PSJJORD,1,DR,0))
SET DR=$$ENDDN^PSGMI($PIECE(DRN,"^"))
IF DND?7N1"DI"
SET DND=$EXTRACT($$ENDTC^PSGMI(+DND),1,8)
+8 SET DIS=$PIECE(DND,"^",2)
SET NEED=$SELECT($PIECE(DND,"^")]"":$PIECE(DND,"^"),1:0)
+9 ;GMZ;PSJ*5*191;Allow for Multiple Dispensed Drug units needed
+10 SET PSJRNW(I)=1_"^"_+NEED
+11 QUIT
End DoDot:2
+12 KILL PSGPLREN("B",PSGP,PSJJORD),PSGPLREN(53.5,PSGPLG,1,PSGP,1,+DRGND)
WRITE !!
End DoDot:1
+13 ;
+14 SET CNT=0
+15 SET (DDRG,OLDWARD)=""
NEW ST
SET ST=$PIECE(ND0,"^",7)
FOR
SET DDRG=$ORDER(^PS(53.5,PSGPLXR,PSGPLG,TM,WDN,RM,PN,PST,DRG,DDRG))
if (DDRG="")!(DDRG="NO DISPENSE DRUG")
QUIT
SET X=$GET(^PS(53.5,PSGPLG,1,+$PIECE(PN,U,2),1,+$PIECE(DRG,U,2),1,+$PIECE(DDRG,U,2),0))
SET DR=+X
SET DND=$PIECE(X,U,2,4)
Begin DoDot:1
+16 SET DRN=$GET(^PS(55,PSGP,5,PSJJORD,1,DR,0))
SET DR=$$ENDDN^PSGMI($PIECE(DRN,"^"))
IF DND?7N1"DI"
SET DND=$EXTRACT($$ENDTC^PSGMI(+DND),1,8)
WRITE !?6,DR,?48,ST,?51,"(DI "_DND_")",?66,"Returns: ____"
QUIT
+17 SET UD=$PIECE(DRN,"^",2)
SET ATC=$PIECE($GET(^PSDRUG(+DRN,8.5)),"^",2)]""
if ATC
SET ATC=$DATA(^(212,"AC",PSGPLWG))
+18 SET DIS=$PIECE(DND,"^",2)
SET NEED=$SELECT($PIECE(DND,"^")]"":$PIECE(DND,"^"),1:0)
IF ATC
SET ATCFF=+$PIECE($GET(^PS(59.7,1,26)),"^",7)
SET ATC=$SELECT(ATCFF:NEED,UD#1:0,DIS]"":+DIS,1:NEED)
IF ATC
IF $SELECT(ATC<1:1,ATC'?1.3N:1,1:ATC#1)
SET ATC=0
+19 IF ATC
SET X=0
SET X=$ORDER(^PS(59.7,X))
IF $PIECE($GET(^(X,26)),U,2)=1
IF PST="OC"
SET ATC=0
+20 SET UD=$SELECT('UD:1,UD=.5:"1/2",UD=.25:"1/4",UD<1:"0"_UD,1:UD)
+21 IF $DATA(PSJRNW)
Begin DoDot:2
+22 IF 'CNT
WRITE !?35,"**** RENEWAL ****"
+23 SET NEED=NEED-$PIECE(PSJRNW(CNT),"^",2)
if NEED<0
SET NEED=0
SET CNT=CNT+1
End DoDot:2
+24 NEW TMPORD
SET TMPORD=PSJJORD_"U"
SET PADE=$SELECT($$DRGSTOCK^PSJPADSI(PSGP,TMPORD,,,+$GET(DRN)):"PADE",1:"")
+25 WRITE !,DR_" ("_+DRN_")",?48,ST,?52,PADE
if (ATC)&(NEED>0)
WRITE ?57,"ATC"
WRITE ?61,$JUSTIFY(UD,4),?68,$JUSTIFY(NEED,4),?75,$SELECT(DIS]"":$JUSTIFY(DIS,4),1:"____")
+26 ;introduces hazardous to handle/dispose warnings *364
+27 KILL PSHAZ
NEW PSHAZ
SET PSHAZ=$$HAZ^PSSUTIL(+DRN)
IF $PIECE(PSHAZ,"^")=1
WRITE !,"<<HAZ Handle>>"
+28 IF $PIECE(PSHAZ,"^",2)=1
WRITE " <<HAZ Dispose>>"
+29 if ST="DISCONTINUED"
SET OLDWARD=1
SET ST=""
End DoDot:1
+30 IF DDRG="NO DISPENSE DRUG"
WRITE !?6,PDRG,?48,ST,?57,"OI"
if ST="DISCONTINUED"
SET OLDWARD=1
SET ST=""
+31 NEW GIVSTR
SET GIVSTR=$SELECT(DO]"":DO_" ",1:"")_RTE_" "_SCH
Begin DoDot:1
+32 NEW MARX,I,Y,X
DO TXT^PSGMUTL(GIVSTR,60)
+33 FOR I=1:1:MARX
if I=1
WRITE !?10,"Give: ",MARX(1)
if I>1
WRITE !?16,MARX(I)
End DoDot:1
+34 if OLDWARD
DO WARDCHK
if AT]""
WRITE !,?65-$LENGTH(AT),AT
WRITE !?7,"Start: ",SD,?37,"Stop: ",FD
+35 IF Y]""
WRITE !?10
FOR Q=1:1:$LENGTH(Y," ")
SET X=$PIECE(Y," ",Q)
if $X+$LENGTH(X)>65
WRITE !?10
WRITE X_" "
+36 KILL ST
+37 QUIT
+38 ;
EXDD ;
+1 WRITE !
SET (DDRG,OLDWARD)=""
FOR
SET DDRG=$ORDER(^PS(53.5,PSGPLXR,PSGPLG,TM,WDN,RM,PN,PST,DRG,DDRG))
if (DDRG="")!(DDRG="NO DISPENSE DRUG")
QUIT
SET DND=^(DDRG)
Begin DoDot:1
+2 SET DR=$PIECE(DDRG,"^",2)
SET DRN=$GET(^PS(55,PSGP,5,PSJJORD,1,DR,0))
SET ID=$PIECE(DRN,"^",3)
SET DR=$$ENDDN^PSGMI($PIECE(DRN,"^"))
WRITE !?6,DR,?48,DIS,?66,"Returns: ____"
if DIS="DISCONTINUED"
SET OLDWARD=1
SET DIS=""
+3 ;*364
KILL PSHAZ
NEW PSHAZ,PSHAZH,PSHAZD
SET (PSHAZH,PSHAZD)=0
SET PSHAZ=$$HAZ^PSSUTIL(+DRN)
+4 IF $PIECE(PSHAZ,"^")=1
SET PSHAZH=1
+5 IF $PIECE(PSHAZ,"^",2)=1
SET PSHAZD=1
+6 IF (PSHAZH&PSHAZD)
WRITE !?6,"<<HAZ Handle>> <<HAZ Dispose>>"
+7 IF (PSHAZH&'PSHAZD)
WRITE !?6,"<<HAZ Handle>>"
+8 IF ('PSHAZH&PSHAZD)
WRITE !?6,"<<HAZ Dispose>>"
End DoDot:1
+9 IF DDRG="NO DISPENSE DRUG"
SET ND1=$GET(^PS(55,PSGP,5,PSJJORD,.2))
SET PDRG=$$ENPDN^PSGMI($PIECE(ND1,"^"))
WRITE !?6,PDRG,?48,DIS,?66,"Returns: ____"
if DIS="DISCONTINUED"
SET OLDWARD=1
SET DIS=""
+10 WRITE !?10,"Give: ",$SELECT(DO]"":DO_" ",1:""),RTE," ",SCH
if OLDWARD
DO WARDCHK
WRITE !?7,"Start: ",SD,?37,"Stop: ",FD
+11 QUIT
+12 ;
FCL ;
+1 IF PGN
IF CML
IF $PIECE(PSGPLWGP,"^",6)
WRITE !!?25,"FILLED BY: ",FACL,!!?25,"CHECKED BY: "_FACL
+2 ;
+1 SET PGN=PGN+1
if $Y
WRITE @IOF
+2 WRITE ?1,"(",PSGPLG,")",?$SELECT($DATA(PSGPLUPF):27,1:32),"PICK LIST REPORT"
if $DATA(PSGPLUPF)
WRITE " (UPDATE)"
WRITE ?64,PPLD,!,"Ward group: ",WGPN,?73-$LENGTH(PGN),"Page: ",PGN,!?18,"For ",PSD," through ",PFD
if NPLF
WRITE !,"Team: ",$SELECT(TM'["zz":TM,1:"** N/F **")
+3 WRITE !!,$SELECT($PIECE(TND,"^",6)&'$PIECE(TND,"^",8):"Bed-Room",1:"Room-Bed"),?15,"Patient",?67,"Units",?74,"Units",!?9,"Medication",?48,"ST",?62,"U/D",?66,"Needed",?74,"Disp'd",!,LINE
QUIT
+4 ;
PAGECK ;
+1 SET PSGPY=$Y
SET PSGPY=$Y+4
IF PSGPY+4>IOSL
WRITE @IOF
+2 QUIT
+3 ;
WARDCHK ; if patient has discontinued orders from a different ward, print the ward and room/bed that the orders were discontinued from.
+1 if '$GET(STPDT)
QUIT
+2 SET VAINDT=$$MINUTES(STPDT,5)
+3 SET DFN=PSGP
DO INP^VADPT
IF PW'=$PIECE(VAIN(4),"^",2)
WRITE ?48,$EXTRACT("(from "_$PIECE(VAIN(4),"^",2)_" "_VAIN(5)_")",1,31)
+4 SET OLDWARD=""
QUIT
+5 ;
MINUTES(STPDT,LESS) ; pass in a FM date/time and the number of minutes (9 or less) to subtract from it
+1 SET VAINDT=$SELECT(...
SET $EXTRACT(STPDT,9,12)<LESS:($EXTRACT(STPDT,1,7)-1)_"."_(($EXTRACT(STPDT,9,12)+2360)-LESS),...
... $EXTRACT(STPDT,11,12)<5:$EXTRACT(STPDT,1,8)_$SELECT($EXTRACT(STPDT,9,10)="10":"09",$EXTRACT(STPDT,9,10)="20":"19",1:$EXTRACT(STPDT,9)_($EXTRACT(STPDT,10)-1))_(60+$EXTRACT(STPDT,12)-LESS),1:STPDT-(LESS*.0001))
+2 QUIT VAINDT
