PSGPLG.m

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

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