PSGPLG ;BIR/CML3-CHOOSE A PICK LIST ;09 JUL 94 / 11:08 AM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
RUN D NOW^%DTC S PSGDT=%,PSGPLG="" D FA K NP,PSGID,PSGOD,S1,S2,W Q
;
FA ; find and show pick list(s) already started for this ward group
W ! K W S W=0,NP="" F S1=$S(PSGPLGF="U":PSGDT,1:0):0 S S1=$O(^PS(53.5,"AB",PSGPLWG,S1)) Q:'S1 F S2=0:0 S S2=$O(^PS(53.5,"AB",PSGPLWG,S1,S2)) Q:'S2 D WRT G:NP["^" CHW
I PSGPLGF="P",$D(^PS(53.5,"AO",PSGPLWG)) W !," - - - - - - - - - - - - - - - - - FILED AWAY - - - - - - - - - - - - - - - - - "
I F S1=0:0 S S1=$O(^PS(53.5,"AO",PSGPLWG,S1)) Q:'S1 F S2=0:0 S S2=$O(^PS(53.5,"AO",PSGPLWG,S1,S2)) Q:'S2 D WRT G:NP["^" CHW
;
CHW I 'W W !,"NO MORE PICK LISTS CURRENTLY FOR THIS WARD GROUP." Q
I W>1 F W !!,"Select 1 - ",W,": " R PSGPLG:DTIME W:'$T $C(7) S:'$T PSGPLG="^" Q:"^"[PSGPLG Q:$D(W(PSGPLG)) D:PSGPLG["?" M1 W:PSGPLG'["?" $C(7)," ??"
I W>1 S:PSGPLG=+PSGPLG PSGPLG=W(PSGPLG) Q
F W !!,"THIS IS THE ONLY PICK LIST FOR THIS WARD GROUP. OK" S %=1 D YN^DICN Q:% D M2
S PSGPLG=$S(%=1:W(1),%=2:"",1:"^") Q
;
M1 W !!,"Choose the number (1-",W,") that corresponds to the PICK LIST that you want to",!,$S(PSGPLGF="U":"UPDATE.",PSGPLGF="D":"enter UNITS DISPENSED.",1:"REPRINT.") Q
M2 W !!,"Enter a 'Y' (or press the RETURN key) to ",$S(PSGPLGF="U":"UPDATE",PSGPLGF="D":"enter UNITS DISPENSED into",1:"PRINT")," this PICK ",$S(PSGPLGF="D":" ",1:"")
W "LIST. Enter an 'N' ",$S(PSGPLGF="U":" ",PSGPLGF="P":" ",1:""),"(or '^') to quit now." Q
;
WRT ;
I W,'(W#17) W $C(7),!!,"Enter an '^' to stop, or press the RETURN key to continue. " R NP:DTIME W:'$T $C(7) S:'$T NP="^" W:NP'["^" *13,# Q:NP["^"
S W=W+1,W(W)=S2,X=$G(^PS(53.5,S2,0)),Y=$O(^(0)),PSGID=$$ENDTC^PSGMI(S1),PSGOD=$$ENDTC^PSGMI($P(X,"^",4))
W !,$J(W,3)," From: ",PSGID,?30,"Through: ",PSGOD W:$S($P(X,"^",11):'$P(X,"^",9),1:0) " (Did NOT complete run)" W:Y="" " (NO data)" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGPLG 1918 printed Oct 16, 2024@18:03:38 Page 2
PSGPLG ;BIR/CML3-CHOOSE A PICK LIST ;09 JUL 94 / 11:08 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
RUN DO NOW^%DTC
SET PSGDT=%
SET PSGPLG=""
DO FA
KILL NP,PSGID,PSGOD,S1,S2,W
QUIT
+1 ;
FA ; find and show pick list(s) already started for this ward group
+1 WRITE !
KILL W
SET W=0
SET NP=""
FOR S1=$SELECT(PSGPLGF="U":PSGDT,1:0):0
SET S1=$ORDER(^PS(53.5,"AB",PSGPLWG,S1))
if 'S1
QUIT
FOR S2=0:0
SET S2=$ORDER(^PS(53.5,"AB",PSGPLWG,S1,S2))
if 'S2
QUIT
DO WRT
if NP["^"
GOTO CHW
+2 IF PSGPLGF="P"
IF $DATA(^PS(53.5,"AO",PSGPLWG))
WRITE !," - - - - - - - - - - - - - - - - - FILED AWAY - - - - - - - - - - - - - - - - - "
+3 IF $TEST
FOR S1=0:0
SET S1=$ORDER(^PS(53.5,"AO",PSGPLWG,S1))
if 'S1
QUIT
FOR S2=0:0
SET S2=$ORDER(^PS(53.5,"AO",PSGPLWG,S1,S2))
if 'S2
QUIT
DO WRT
if NP["^"
GOTO CHW
+4 ;
CHW IF 'W
WRITE !,"NO MORE PICK LISTS CURRENTLY FOR THIS WARD GROUP."
QUIT
+1 IF W>1
FOR
WRITE !!,"Select 1 - ",W,": "
READ PSGPLG:DTIME
if '$TEST
WRITE $CHAR(7)
if '$TEST
SET PSGPLG="^"
if "^"[PSGPLG
QUIT
if $DATA(W(PSGPLG))
QUIT
if PSGPLG["?"
DO M1
if PSGPLG'["?"
WRITE $CHAR(7)," ??"
+2 IF W>1
if PSGPLG=+PSGPLG
SET PSGPLG=W(PSGPLG)
QUIT
+3 FOR
WRITE !!,"THIS IS THE ONLY PICK LIST FOR THIS WARD GROUP. OK"
SET %=1
DO YN^DICN
if %
QUIT
DO M2
+4 SET PSGPLG=$SELECT(%=1:W(1),%=2:"",1:"^")
QUIT
+5 ;
M1 WRITE !!,"Choose the number (1-",W,") that corresponds to the PICK LIST that you want to",!,$SELECT(PSGPLGF="U":"UPDATE.",PSGPLGF="D":"enter UNITS DISPENSED.",1:"REPRINT.")
QUIT
M2 WRITE !!,"Enter a 'Y' (or press the RETURN key) to ",$SELECT(PSGPLGF="U":"UPDATE",PSGPLGF="D":"enter UNITS DISPENSED into",1:"PRINT")," this PICK ",$SELECT(PSGPLGF="D":" ",1:"")
+1 WRITE "LIST. Enter an 'N' ",$SELECT(PSGPLGF="U":" ",PSGPLGF="P":" ",1:""),"(or '^') to quit now."
QUIT
+2 ;
WRT ;
+1 IF W
IF '(W#17)
WRITE $CHAR(7),!!,"Enter an '^' to stop, or press the RETURN key to continue. "
READ NP:DTIME
if '$TEST
WRITE $CHAR(7)
if '$TEST
SET NP="^"
if NP'["^"
WRITE *13,#
if NP["^"
QUIT
+2 SET W=W+1
SET W(W)=S2
SET X=$GET(^PS(53.5,S2,0))
SET Y=$ORDER(^(0))
SET PSGID=$$ENDTC^PSGMI(S1)
SET PSGOD=$$ENDTC^PSGMI($PIECE(X,"^",4))
+3 WRITE !,$JUSTIFY(W,3)," From: ",PSGID,?30,"Through: ",PSGOD
if $SELECT($PIECE(X,"^",11)
WRITE " (Did NOT complete run)"
if Y=""
WRITE " (NO data)"
QUIT
