| [613] | 1 | PSIVSUS1 ;BIR/RGY-REPRINT LABEL FROM SUSPENSE ;24 JAN 94 / 11:37 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^PS(55 is supported by DBIA 2191.
|
|---|
| 5 | ;
|
|---|
| 6 | D ^PSIVXU I $D(XQUIT) K XQUIT Q
|
|---|
| 7 | BEG S Y=1,BAT="@",PSIVRPNT=1 F I=1:1 S BAT=$O(^PS(55,"PSIVSUS",PSIVSN,BAT)) Q:BAT="" W !?5,I,") Labels printed on: " S Y=$E(BAT,2,999) X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) S Y=BAT
|
|---|
| 8 | I Y W !!,"*** There are no labels to reprint ! ***" G Q
|
|---|
| 9 | ASK S X="Reprint batch #^"_(I-1)_"^^^QUX=+QUX" D ENQ^PSIV G:"^"[X Q I X["?" S HELP="RNTBAT" D ^PSIVHLP1 G ASK
|
|---|
| 10 | S PSIVDT=+X\1,X="A" F Y=1:1 S X=$O(^PS(55,"PSIVSUS",PSIVSN,X)) Q:X=""!(Y=PSIVDT)
|
|---|
| 11 | I X="" W $C(7)," ???" G ASK
|
|---|
| 12 | OV S PSIVDT=X S Y=$E(X,2,999) X ^DD("DD") W " Labels printed on ",$P(Y,"@")," ",$P(Y,"@",2)
|
|---|
| 13 | I PSIVPL'=ION S ZTIO=PSIVPL,ZTDESC="REPRINT LABELS FROM SUSPENSE (IV)",ZTRTN="DQLBL^PSIVSUS1" D QSET G Q
|
|---|
| 14 | DQLBL F DFN=0:0 S DFN=$O(^PS(55,"PSIVSUS",PSIVSN,PSIVDT,DFN)) Q:'DFN D ENIV^PSJAC F ON=0:0 S ON=$O(^PS(55,"PSIVSUS",PSIVSN,PSIVDT,DFN,ON)) Q:'ON F SDT=0:0 S SDT=$O(^PS(55,"PSIVSUS",PSIVSN,PSIVDT,DFN,ON,SDT)) Q:'SDT D LA
|
|---|
| 15 | Q K BAT,PSIVDOSE,PSIVDT,PSIVNOL,PSIVRPNT,SDT,Z
|
|---|
| 16 | Q1 D ENIVKV^PSGSETU S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 17 | Q
|
|---|
| 18 | LA Q:"PDH"[$P($G(^PS(55,DFN,"IV",ON,0)),"^",17)
|
|---|
| 19 | ;S PSIVNOL=^PS(55,"PSIVSUS",PSIVSN,PSIVDT,DFN,ON,SDT),PSIVDOSE=$P(PSIVNOL,"^",2),PSIVCT=1,ACTION=1,TRACK=3,P16=$P(PSIVNOL,"^",3),PSIVNOL=+PSIVNOL,P(4)=$P(^PS(55,DFN,"IV",ON,0),"^",4) D ^PSIVLTR D ^PSIVHYPL:P(4)="H",^PSIVLABL:"APSC"[P(4) Q
|
|---|
| 20 | S PSIVNOL=^PS(55,"PSIVSUS",PSIVSN,PSIVDT,DFN,ON,SDT),PSIVDOSE=$P(PSIVNOL,"^",2),PSIVCT=1,ACTION=1,TRACK=3,P16=$P(PSIVNOL,"^",3),PSIVNOL=+PSIVNOL,P(4)=$P(^PS(55,DFN,"IV",ON,0),"^",4)
|
|---|
| 21 | D ^PSIVLTR
|
|---|
| 22 | S PSIVWMFL=1
|
|---|
| 23 | NEW PSJID,PSIVOID,PSIVID,X,XX
|
|---|
| 24 | F PSJID=0:0 S PSJID=$O(^PS(55,"PSIVSUS",PSIVSN,PSIVDT,DFN,ON,SDT,PSJID)) Q:'PSJID D REPRT^PSIVLBL1
|
|---|
| 25 | ;
|
|---|
| 26 | ;Kill old ID and set newly reprinted ID.
|
|---|
| 27 | ;
|
|---|
| 28 | F X=0:0 S X=$O(PSIVOID(X)) Q:'X D
|
|---|
| 29 | . K ^PS(55,"PSIVSUS",PSIVSN,PSIVDT,DFN,ON,SDT,X)
|
|---|
| 30 | F X=0:0 S X=$O(PSIVID(X)) Q:'X D
|
|---|
| 31 | . S ^PS(55,"PSIVSUS",PSIVSN,PSIVDT,DFN,ON,SDT,X)=""
|
|---|
| 32 | K PSIVWMFL,PSIVOID,PSIVID
|
|---|
| 33 | Q
|
|---|
| 34 | ENT ;Will print man. list for suspense
|
|---|
| 35 | D ^PSIVXU I $D(PSIVXU) K PSIVXU Q
|
|---|
| 36 | I PSIVPR'=ION K ZTDTH S ZTIO=PSIVPR,ZTDESC="PRINT MANUFACTURING LIST FOR SUSPENSE (IV)",ZTRTN="DQENT^PSIVSUS1" D QSET G QENT
|
|---|
| 37 | DQENT K ^PS(55,"PSIVSUSM",PSIVSN,$J),PSIVOD,PSIVCD,PSIVMT S PSIVGL1="PSIVSUSM",PSIVGL2=$J
|
|---|
| 38 | F DFN=0:0 S DFN=$O(^PS(55,"PSIVSUS",PSIVSN,DFN)) Q:'DFN D ENIV^PSJAC,RGY
|
|---|
| 39 | D ENT^PSIVMAN1
|
|---|
| 40 | QENT W:'$D(PSIVPR)&($Y) @IOF K ^PS(55,"PSIVSUSM",PSIVSN,$J),D,DA,DFN,I,JJ,JJ1,ON,P,PSIVGL1,PSIVGL2,PSIVTTM,SDT,TOTAL,VAERR,X,Y,Z,Z1,Z2 D Q1
|
|---|
| 41 | Q
|
|---|
| 42 | RGY F ON=0:0 S ON=$O(^PS(55,"PSIVSUS",PSIVSN,DFN,ON)) Q:'ON D SETP I "EOPHD"'[P(17) F SDT=0:0 S SDT=$O(^PS(55,"PSIVSUS",PSIVSN,DFN,ON,SDT)) Q:'SDT S PSIVTTM=+^(SDT) D ENS^PSIVMAN
|
|---|
| 43 | Q
|
|---|
| 44 | SETP S Y=$G(^PS(55,DFN,"IV",ON,0)) F X=1:1:23 S P(X)=$P(Y,"^",X)
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | QSET ; Set up for queueing.
|
|---|
| 48 | F X="PSIVSN","PSIVDT","PSIVSITE","PSJSYSW0","PSJSYSP0","PSJSYSU" S:$D(@X) ZTSAVE(X)=""
|
|---|
| 49 | D ^%ZTLOAD W:$D(ZTSK) !,"Queued."
|
|---|
