| 1 | PSGPLDP ;BIR/CML3-ENTER AND FILE UNITS DISPENSED ;15 JAN 97 / 11:13 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | D ENCV^PSGSETU Q:$D(XQUIT) S PSGPLGF="D",PRN=""
|
|---|
| 5 | CHK ;
|
|---|
| 6 | D NOW^%DTC S PSGDT=% F Q=0:0 S Q=$O(^PS(53.5,"AB",Q)) Q:'Q Q:$O(^(Q,0))
|
|---|
| 7 | I 'Q W !,"NO PICK LIST AVAILABLE",$S($D(^PS(53.5,"AB")):", YET.",1:".") G DONE
|
|---|
| 8 | ASK R !!,"Select WARD GROUP or PICK LIST: ",X:DTIME W:'$T $C(7) S:'$T X="^" G:"^"[X DONE I X=+X D NL I Y D RUN1 G CHK
|
|---|
| 9 | ;D:X?1."?" HLP S DIC(0)="EIMQZ",DIC="^PS(57.5,",DIC("S")="I $P($G(^PS(57.5,+Y,0)),""^"",2)=""P"",$D(^PS(53.5,""AB"",+Y)),$O(^(+Y,0))<"_PSGDT D ^DIC K DIC G:Y'>0 ASK S (WG,PSGPLWG)=+Y,PSGPLWGN=Y(0,0) D RUN G CHK
|
|---|
| 10 | D:X?1."?" HLP S DIC(0)="EIMQZ",DIC="^PS(57.5,",DIC("S")="I $P($G(^PS(57.5,+Y,0)),""^"",2)=""P"",$D(^PS(53.5,""AB"",+Y))" D ^DIC K DIC G:Y'>0 ASK S (WG,PSGPLWG)=+Y,PSGPLWGN=Y(0,0) D RUN G CHK
|
|---|
| 11 | ;
|
|---|
| 12 | DONE ;
|
|---|
| 13 | D:$D(^PS(53.5,"AF")) ENQ D ENKV^PSGSETU K AM,DR,DRG,FA,LMT,OK,PSGLCNT,PSJJORD,PC,PDD,PDN,PN,PND,PPN,PR,PRN,PSGP,PSGPLG,PSGPLGF,PSGPLTND,PSGPLWG,PSGPLWGN,PW,Q,RB,SCH,PSSN,ST,TM,WDN,WF,WSF,WG,X,Y Q
|
|---|
| 14 | ;
|
|---|
| 15 | RUN ; choose pick list and go through it
|
|---|
| 16 | D ^PSGPLG Q:"^"[PSGPLG D RUN1
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | RUN1 ;
|
|---|
| 20 | I '$$LOCK^PSGPLUTL(PSGPLG,"PSGPL") W $C(7),!!,"Another terminal is acccessing this pick list." Q
|
|---|
| 21 | I $O(^PS(53.5,PSGPLG,0))="" D AF
|
|---|
| 22 | I $O(^PS(53.5,PSGPLG,0))]"" D ^PSGPLDP0
|
|---|
| 23 | D UNLOCK^PSGPLUTL(PSGPLG,"PSGPL") Q
|
|---|
| 24 | ;
|
|---|
| 25 | AF ;
|
|---|
| 26 | ;*** what are the AO and AB xrefs that follow?
|
|---|
| 27 | W !!?3,"*** NO DATA" D NOW^%DTC S Y=+$P(^PS(53.5,PSGPLG,0),"^",3) I $S('Y:1,1:%>Y) S $P(^(0),"^",5)=2,^PS(53.5,"AO",PSGPLWG,Y,PSGPLG)="" K ^PS(53.5,"AB",PSGPLWG,Y,PSGPLG) W " (PICK LIST AUTOMATICALLY FILED AWAY)"
|
|---|
| 28 | W " ***" Q
|
|---|
| 29 | ;
|
|---|
| 30 | ENQ ; queue PSGPLF
|
|---|
| 31 | D NOW^%DTC S AM=15 F L +^PS(59.7,1,63.5):0 I S X=$P($G(^PS(59.7,1,63.5)),"^",4),ST=$S(X>%:X,1:%),X=$$EN^PSGCT(ST,AM) S $P(^PS(59.7,1,63.5),"^",4)=X L -^PS(59.7,1,63.5) Q
|
|---|
| 32 | S PSGTID=X,PSGTIR="EN^PSGPLF",ZTDESC="FILE AWAY PICK LIST",ZTIO="" K ZTSAVE D ENNOIO^PSGTI Q
|
|---|
| 33 | ;
|
|---|
| 34 | NL ; numeric look-up
|
|---|
| 35 | S Y=$G(^PS(53.5,X,0)) I $S('Y:1,'$P(Y,"^",2):1,1:'$D(^PS(53.5,"AB",$P(Y,"^",2),+$P(Y,"^",3),X))) S Y=0 Q
|
|---|
| 36 | S PSGPLG=X,X=^PS(53.5,PSGPLG,0),Y=$$ENDTC^PSGMI($P(X,"^",3)),PSGPLWG=$P(X,"^",2),PSGPLWGN=$S('$D(^PS(57.5,PSGPLWG,0)):PSGPLWG_";PS(57.5,",$P(^(0),"^")]"":$P(^(0),"^"),1:PSGPLWG_";PS(57.5,"),PSGOD=$$ENDTC^PSGMI($P(X,"^",4))
|
|---|
| 37 | W " ",PSGPLWGN,!?$L(PSGPLWG)+21,Y," thru ",PSGOD S Y=1 Q
|
|---|
| 38 | ;
|
|---|
| 39 | HLP ;
|
|---|
| 40 | W !?2,"Select a Ward Group for which a pick list has run for which you wish to enter",!,"the units actually dispensed.",!?2,"You may also select a pick list by its number, which prints in the upper left",!,"corner of each pick list." Q
|
|---|
