source: FOIAVistA/tag/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVSUS1.m@ 636

PSIVSUS1 ;BIR/RGY-REPRINT LABEL FROM SUSPENSE ;24 JAN 94 / 11:37 AM
 ;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97
 ;
 ; Reference to ^PS(55 is supported by DBIA 2191.
 ;
 D ^PSIVXU I $D(XQUIT) K XQUIT Q
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
 I Y W !!,"*** There are no labels to reprint ! ***" G Q
ASK S X="Reprint batch #^"_(I-1)_"^^^QUX=+QUX" D ENQ^PSIV G:"^"[X Q I X["?" S HELP="RNTBAT" D ^PSIVHLP1 G ASK
 S PSIVDT=+X\1,X="A" F Y=1:1 S X=$O(^PS(55,"PSIVSUS",PSIVSN,X)) Q:X=""!(Y=PSIVDT)
 I X="" W $C(7)," ???" G ASK
OV S PSIVDT=X S Y=$E(X,2,999) X ^DD("DD") W "   Labels printed on ",$P(Y,"@")," ",$P(Y,"@",2)
 I PSIVPL'=ION S ZTIO=PSIVPL,ZTDESC="REPRINT LABELS FROM SUSPENSE (IV)",ZTRTN="DQLBL^PSIVSUS1" D QSET G Q
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
Q K BAT,PSIVDOSE,PSIVDT,PSIVNOL,PSIVRPNT,SDT,Z
Q1 D ENIVKV^PSGSETU S:$D(ZTQUEUED) ZTREQ="@"
 Q
LA Q:"PDH"[$P($G(^PS(55,DFN,"IV",ON,0)),"^",17)
 ;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
 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
 S PSIVWMFL=1
 NEW PSJID,PSIVOID,PSIVID,X,XX
 F PSJID=0:0 S PSJID=$O(^PS(55,"PSIVSUS",PSIVSN,PSIVDT,DFN,ON,SDT,PSJID)) Q:'PSJID  D REPRT^PSIVLBL1
 ;
 ;Kill old ID and set newly reprinted ID.
 ;
 F X=0:0 S X=$O(PSIVOID(X)) Q:'X  D
 . K ^PS(55,"PSIVSUS",PSIVSN,PSIVDT,DFN,ON,SDT,X)
 F X=0:0 S X=$O(PSIVID(X)) Q:'X  D
 . S ^PS(55,"PSIVSUS",PSIVSN,PSIVDT,DFN,ON,SDT,X)=""
 K PSIVWMFL,PSIVOID,PSIVID
 Q
ENT ;Will print man. list for suspense
 D ^PSIVXU I $D(PSIVXU) K PSIVXU Q
 I PSIVPR'=ION K ZTDTH S ZTIO=PSIVPR,ZTDESC="PRINT MANUFACTURING LIST FOR SUSPENSE (IV)",ZTRTN="DQENT^PSIVSUS1" D QSET G QENT
DQENT K ^PS(55,"PSIVSUSM",PSIVSN,$J),PSIVOD,PSIVCD,PSIVMT S PSIVGL1="PSIVSUSM",PSIVGL2=$J
 F DFN=0:0 S DFN=$O(^PS(55,"PSIVSUS",PSIVSN,DFN)) Q:'DFN  D ENIV^PSJAC,RGY
 D ENT^PSIVMAN1
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
 Q
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
 Q
SETP S Y=$G(^PS(55,DFN,"IV",ON,0)) F X=1:1:23 S P(X)=$P(Y,"^",X)
 Q
 ;
QSET ; Set up for queueing.
 F X="PSIVSN","PSIVDT","PSIVSITE","PSJSYSW0","PSJSYSP0","PSJSYSU" S:$D(@X) ZTSAVE(X)=""
 D ^%ZTLOAD W:$D(ZTSK) !,"Queued."