PSIVLBL1 ;BIR/RGY-PRINT LABEL FROM WARD LIST ;24 Aug 2001  3:59 PM
 ;;5.0; INPATIENT MEDICATIONS ;**69,58,81,97,104**;16 DEC 97
 ;
 ; Reference to ^PS(55 is supported by DBIA 2191.
 ; Reference to ^%DT is supported by DBIA 10003.
 ; Reference to ^%ZIS is supported by DBIA 10086.
 ; Reference to ^%ZTLOAD is supported by DBIA 10063.
 ; Reference to ^DICN is supported by DBIA 10009.
 ; Reference to ^DIR is supported by DBIA 10026.
 ; Reference to ^VALM1 is supported by DBIA 10116.
 ;
START S Y=1 W !!,"Schedule labels for DATE: TODAY//" R X:DTIME S:'$T X="^" S:X="" X="T" Q:X["^"  I X'["?" S %DT="EX" D ^%DT
 G:Y<1 START
 I X["?" S HELP="LBL1" D ^PSIVHLP S X="?" D ^%DT G START
ASK S PSIVDT=Y\1 D ^PSIVWL1 G QUIT:'$D(PSIVOD)!('$D(PSIVCD))
 I PSIVPL'=ION D QUE G QUIT
DEQ ;
 L +^PS(55,"PSIVWL",PSIVSN):1 E  W:$Y @IOF W !!,"**** WARNING --- LABELS NOT",!,"   RUN, WARD LIST IN PROGRESS" G QUIT
 S PSIVT="" F PSIVLBL1=0:0 S PSIVT=$O(PSIVOD(PSIVT)) Q:PSIVT=""  S WRD="" D @("LBL"_$S($D(^PS(55,"PSIVWLM",PSIVSN,PSIVT_PSIVOD(PSIVT))):"M",1:"W"))
 I $G(PSJRPFLG) D
 . W !!,"*** NOTE ***"
 . W !!,"Schedule labels had already printed for the selected manufacturing time."
 . W !,"Please use the Reprint Scheduled Labels option instead.",!
 . K PSJRPFLG
QUIT L -^PS(55,"PSIVWL",PSIVSN) S:$D(ZTQUEUED) ZTREQ="@" K %,%DT,%T,D,DFN,I,JJ,NOFLG,ON,P,PSCT,PSIV,PSIVCD,PSIVDT,PSIVDOSE,PSIVMT,PSIVOD,PSIVNOL,PSIVT,VAERR,WRD,X,X1,X2,Y,Z,ZTSK,OIX1,OIX2
 Q
LBLM ;
 N OIX1,OIX2 I '$D(^PS(55,"PSIVWLM",PSIVSN,PSIVT_PSIVOD(PSIVT),PSIVT)) D DESC(PSIVT) Q
 S OIX1=0 F  S OIX1=$O(^PS(55,"PSIVWLM",PSIVSN,PSIVT_PSIVOD(PSIVT),PSIVT,OIX1)) Q:OIX1=""  S OIX2=0 F  S OIX2=$O(^PS(55,"PSIVWLM",PSIVSN,PSIVT_PSIVOD(PSIVT),PSIVT,OIX1,OIX2)) Q:OIX2=""  D LBLM1
 K JX Q
LBLM1 ;
 S NOFLG=1 N DFNX,ONX
 S DFNX=0 F  S DFNX=$O(^PS(55,"PSIVWLM",PSIVSN,PSIVT_PSIVOD(PSIVT),PSIVT,OIX1,OIX2,DFNX)) Q:'DFNX  D
 . S DFN=+DFNX D ENIV^PSJAC S DFN=DFNX,ONX=0 F  S ONX=$O(^PS(55,"PSIVWLM",PSIVSN,PSIVT_PSIVOD(PSIVT),PSIVT,OIX1,OIX2,DFN,ONX)) Q:'ONX  D
 .. S ON=+ONX,WRD=$P(^(+ON),"^",2),X1=OIX1,X2=OIX2 D MEOW
 ; naked reference on line above refers to the ^PS(55,"PSIVWLM" reference on the line preceding the naked reference
 D:NOFLG DESC(PSIVT)
 Q
LBLW ; loop through ward lists
 N DFNX,ONX,WRDX
 S NOFLG=1 S WRDX=0 F  S WRDX=$O(^PS(55,"PSIVWL",PSIVSN,WRDX)) Q:WRDX=""  D
 . S WRD=WRDX S DFNX=0 F  S DFNX=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFNX)) Q:'DFNX  D
 .. S DFN=+DFNX D ENIV^PSJAC S DFN=DFNX S ONX=0 F  S ONX=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN,ONX)) Q:'ONX  S ON=+ONX D MEOW
 D:NOFLG DESC(PSIVT)
 Q
MEOWRPT ;Reprint from man/ward list
 I '$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN,+ON,0)) D MEOW Q
 S PSIVWMFL=1 ;this flag indicate prt/reprt from war/man list
 NEW PSJID,PSIVOID,PSIVID,X,XX
 F PSJID=0:0 S PSJID=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN,+ON,PSJID)) Q:'PSJID  D REPRT
 ;
 ; Kill old ID and set newly reprinted ID.
 ;
 F X=0:0 S X=$O(PSIVOID(X)) Q:'X  D
 . K ^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN,+ON,X)
 F X=0:0 S X=$O(PSIVID(X)) Q:'X  D
 . S ^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN,+ON,X)=""
 K PSIVWMFL,PSIVOID,PSIVID
 Q
REPRT ; Reprint labels using existing bcma ID
 S PSIVOID(PSJID)=""
 NEW PSJLB S XX=$G(^PS(55,DFN,"IVBCMA",PSJID,0)) Q:XX=""
 F X=1:1:8 S PSJLB(X)=$P(XX,U,X)
 I $S(PSJLB(4)="C":1,PSJLB(4)="G":1,PSJLB(4)="I":1,PSJLB(7)'="":1,1:0) Q
 S PSIVCTD=0,PSIVCT=1,PSIVNOL=1,P(4)=$P(^PS(55,DFN,"IV",+ON,0),"^",4)
 D REPRT^PSIVLBRP(DFN_"V"_PSJID)
 Q
MEOW ; Print labels
 S PSIVCT=1,PSIVNOL=+^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN,+ON),P16=$P(^(+ON),"^",3),PSIVDOSE=$P(^(+ON),"^",2) I '$P(^(+ON),"^",4) S $P(^(+ON),"^",4)=1 K PSIVCT
 I PSIVNOL=0 K PSIVDOSE,PSIVCT,PSIVWMFL,PSIVID Q
 N PSJSCH,PSJST,A,PSJOK
 S PSJSCH=$P(^PS(55,DFN,"IV",+ON,0),"^",9),PSJST=$$ONE^PSJBCMA(DFN,ON,PSJSCH)
 S PSJOK=1 I PSJST="O" S A=0 F  S A=$O(^PS(55,DFN,"IV",+ON,"LAB",A)) Q:A=""  I $P($G(^(A,0)),"^",3)=1 S PSJOK=0 Q
 Q:'PSJOK
 Q:"HOD"[$P(^PS(55,DFN,"IV",+ON,0),"^",17)
 I $O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN,ON,0)) D  Q
 . S NOFLG=0,PSJRPFLG=1
 S PSIVWMFL=1
 S IONOFF="",P(4)=$P(^PS(55,DFN,"IV",+ON,0),"^",4),ACTION=1,TRACK=2 D ^PSIVLTR D ^PSIVHYPL:P(4)="H",^PSIVLABL:"APSC"[P(4)
 I $D(PSIVID) S X=0 F  S X=$O(PSIVID(X)) Q:'X  D
 . S ^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN,ON,X)=""
 S NOFLG=0
 K PSIVDOSE,PSIVCT,PSIVWMFL,PSIVID Q
 ;
QUE S ZTIO=PSIVPL,ZTDESC="PRINT SCHEDULED IV LABELS",ZTRTN="DEQ^PSIVLBL1",PSIVT="",ZTSAVE("PSJSYSP0")=""
 F I=0:0 S PSIVT=$O(PSIVMT(PSIVT)) Q:PSIVT=""  S (ZTSAVE("PSIVCD("""_PSIVT_""")"),ZTSAVE("PSIVMT("""_PSIVT_""")"),ZTSAVE("PSIVOD("""_PSIVT_""")"))=""
 F X="PSIVSN","PSIVSITE","PSJSYSW0","PSJSYSU","IONOFF" S ZTSAVE(X)=""
 D ^%ZTLOAD W:$D(ZTSK) !,"Queued." Q
 ;
ENLBLI ;Print individual labels.
 D FULL^VALM1
 S PSJORD=ON D ENNH^PSIVORV2(ON)
 I ON'["V" W !!,$C(7),$C(7),"You may not print labels for a pending order." W ! K DIR S DIR(0)="E" D ^DIR K DIR G Q
A1 ;
 I "EDP"[$P(^PS(55,DFN,"IV",+ON,0),U,17) W !,$C(7),$C(7),"WARNING, this order is not active.",!,"Continue" S %=2 D YN^DICN G:%=2!(%=-1) Q G:%=0 A1
 D PAUSE^VALM1
 S PSIVLBTP=1,PSJMORE=0 D EN^VALM("PSJ LM IV LABELS") G Q
LBLBEG R !!,"Number of labels to print: ",X:DTIME Q:'$T!("^"[X)  S:X["?" HELP="NOL" D:X["?" ^PSIVHLP1 G:X["?" LBLBEG K:X'=+X!(X>10)!(X<1)!(X?.E1"."1N.N) X W:'$D(X) $C(7),$C(7),"??" G:'$D(X) LBLBEG S PSIVNOL=+X,PSIVCT=1
 ;
USAGE ;
 W !,"Count as daily usage" S %=1 D YN^DICN G:%=-1 Q K:%=1 PSIVCT I %=0 S HELP="NCILBL" D ^PSIVHLP1 G USAGE
 S P16=$S('$D(PSIVCT):$P(^PS(55,DFN,"IV",+ON,0),"^",16),1:0) S:'$D(PSIVCT) $P(^(0),"^",16)=P16+X
 S IONOFF="",IOP=PSIVPL,%ZIS="NQ" D ^%ZIS G:POP Q I IO=IO(0),($E(IOST)="C") W !!! D DEQIA,Q D HOME^%ZIS Q
 D HOME^%ZIS
 W ! S ZTDTH=$H,ZTIO=PSIVPL,ZTDESC="PRINT INDIVIDUAL IV LABELS",ZTRTN="DEQIA^PSIVLBL1" F X="IONOFF","P16","PSIVAC","PSIVNOL","PSIVSN","PSIVSITE","DFN","ON","PSJSYSW0","PSJSYSU","PSJSYSP0" S ZTSAVE(X)=""
 S:$D(PSIVCT) ZTSAVE("PSIVCT")="" D ^%ZTLOAD W:$D(ZTSK) !,"Queued."
Q ;K %,IONOFF,ON,ORNS,ORPV,ORSTOP,ORSTRT,ORSTS,ORVP,P,PSIVC,PSIVREA,J,N,N2,ORIFN,P17,SCHED,PSIVDOSE,PSIVNOL,PSIVNOW,VAERR
 K %,IONOFF,ORNS,ORPV,ORSTOP,ORSTRT,ORSTS,ORVP,PSIVC,PSIVREA,J,N,N2,ORIFN,P17,SCHED,PSIVDOSE,PSIVNOL,PSIVNOW,VAERR
 Q
DEQIA ;
 K PSIVDOSE S P(4)=$P(^PS(55,DFN,"IV",+ON,0),"^",4)
 S ACTION=1,TRACK=1 D ^PSIVLTR
 ;
 D ^PSIVHYPL:P(4)="H",^PSIVLABL:"APSC"[P(4) S:$D(ZTQUEUED) ZTREQ="@"
 Q
DESC(X) ;Expand the IV type.
 NEW XX,Y,DESC,X1,X2 S Y=$$CODES^PSIVUTL(X,55.01,.04)
 S XX="***NO "_Y_" DATA***"
 NEW MARX D TXT^PSGMUTL(XX,$P(PSIVSITE,U,13))
 F XX=1:1:(+PSIVSITE+$P(PSIVSITE,U,16))  W:XX>2 $G(MARX(XX-2)) W !
 Q