- 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 Feb 18, 2025@23:29:15 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