| [613] | 1 | PSGPLRP ;BIR/CML3-PICK LIST REPRINT DRIVER ;18 APR 95 / 4:20 PM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**50**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | D ENCV^PSGSETU I $D(XQUIT) Q
|
|---|
| 5 | ;
|
|---|
| 6 | START ;
|
|---|
| 7 | R !!,"Select WARD GROUP or PICK LIST: ",X:DTIME W:'$T $C(7) S:'$T X="^" G:"^"[X DONE
|
|---|
| 8 | I X=+X,$D(^PS(53.5,X,0)) S PSGPLG=X I '$D(^PS(53.5,"AF",PSGPLG)) S Y=^PS(53.5,X,0),PSGPLWG=+$P(Y,U,2),PSGPLWGP=$G(^PS(57.5,PSGPLWG,5)),PSGID=$P(Y,"^",3)
|
|---|
| 9 | I S PSGOD=$P(Y,"^",4),Y=$S('$D(^PS(57.5,PSGPLWG,0)):PSGPLWG_";PS(57.5",$P(^(0),"^")]"":$P(^(0),"^"),1:PSGPLWG_";PS(57.5") W " ",Y,!?$L(PSGPLG)+21,$$ENDTC^PSGMI(PSGID)," thru ",$$ENDTC^PSGMI(PSGOD) D RP1 G START
|
|---|
| 10 | D:X?1."?" HLP K DIC S DIC="^PS(57.5,",DIC(0)="EIMQ",DIC("S")="I $D(^PS(57.5,+Y,0)),$P(^(0),""^"",2)=""P"",$D(^PS(53.5,""AB"",+Y))!$D(^PS(53.5,""AO"",+Y))" D ^DIC K DIC G:+Y'>0 START
|
|---|
| 11 | S PSGPLWG=+Y,PSGPLWGP=$G(^PS(57.5,PSGPLWG,5)) D NOW^%DTC S PSGDT=%,PSGPLGF="P",PSGPLG="" F D ^PSGPLG Q:"^"[PSGPLG D RP1
|
|---|
| 12 | G START
|
|---|
| 13 | ;
|
|---|
| 14 | DONE ;
|
|---|
| 15 | D ENKV^PSGSETU K PSGPLGF,PSGPLG,PSGPLWG,PSGPLWGP,PSGPLUPF,PN,RB,WDN,TM,Y,PSGPLSTR Q
|
|---|
| 16 | ;
|
|---|
| 17 | RP1 ;
|
|---|
| 18 | K PSGPLUPF S %=2 I $D(^PS(53.5,"AU",PSGPLG)) D PW Q:%<1
|
|---|
| 19 | D PAT Q:$D(DUOUT)
|
|---|
| 20 | I %=2,$D(^PS(53.5,PSGPLG,0)) I '$P(^(0),"^",9) W $C(7),$C(7),!!?33,"*** WARNING ***",!,"THIS PICK LIST STARTED TO RUN ",$$ENDTC^PSGMI($P(^(0),"^",11)),", BUT HAS NOT RUN TO COMPLETION."
|
|---|
| 21 | K ZTSAVE S ZTDESC="UNIT DOSE PICK LIST REPRINT",PSGTIR="^PSGPLR",(ZTSAVE("PSGPLG"),ZTSAVE("PSGPLWG"),ZTSAVE("PSGPLWGP"),ZTSAVE("PSGPLSTR"))="" S:$D(PSGPLUPF) ZTSAVE("PSGPLUPF")="" S:$D(PSJPRN) ZTSAVE("PSJPRN")=""
|
|---|
| 22 | D ENDEV^PSGTI I POP W !,"No device selected. Option terminated." Q
|
|---|
| 23 | I $D(IO("Q")) W:$D(ZTSK) !,"Pick list print queued!" Q
|
|---|
| 24 | W !!," ...one moment, please..." D ^PSGPLR D ^%ZISC Q
|
|---|
| 25 | ;
|
|---|
| 26 | HLP ;
|
|---|
| 27 | W !?2,"Select a Ward Group for which a pick list has run for which you wish to",!,"reprint.",!?2,"You may also select a Pick List by number, which prints in the upper left",!,"corner of each pick list." Q
|
|---|
| 28 | ;
|
|---|
| 29 | PW ; print which? pick list or update
|
|---|
| 30 | F W !!,"This pick list has an update.",!,"Do you want to print the update" S %=2 D YN^DICN Q:% W !!?2,"An update has been run for this pick list. Enter 'YES' to print the update",!,"only. Enter 'NO' to print the complete pick list."
|
|---|
| 31 | S:%=1 PSGPLUPF=1 Q
|
|---|
| 32 | ;
|
|---|
| 33 | PAT ; select patient to start from
|
|---|
| 34 | I $G(PSGPLUPF)=1 S DIC("S")="I $P(^(0),U,5)=1"
|
|---|
| 35 | S PSGPLSTR="",DIC="^PS(53.5,"_PSGPLG_",1,",DIC("A")="Select PATIENT to start from (optional): ",DIC(0)="AEQZ" D ^DIC K DIC Q:Y<0
|
|---|
| 36 | S WDN=$S($P(^PS(53.5,PSGPLG,0),"^",7)=1:"zns",1:$P(Y(0),"^",3)),TM=$P(Y(0),"^",2)
|
|---|
| 37 | S RB=$P($G(^PS(53.5,PSGPLG,1,+Y(0),0)),U,4) I RB]"",$P(^PS(53.5,PSGPLG,0),U,6),RB'="zz" S RB=$S($P(RB,"-",2)?1N:0,1:"")_$P(RB,"-",2)_"-"_$P(RB,"-")
|
|---|
| 38 | S RB=$S($P(^PS(53.5,PSGPLG,0),"^",8)=1:"zz",RB="":"zz",1:RB)
|
|---|
| 39 | S PN=$E($P($G(^DPT(+Y(0),0)),U),1,12)_U_+Y(0)
|
|---|
| 40 | Q:'$D(^PS(53.5,"AC",PSGPLG,TM,WDN,RB,PN))
|
|---|
| 41 | S PSGPLSTR=TM_"^"_WDN_"^"_RB_"^"_PN
|
|---|
| 42 | Q
|
|---|
