- PSIVMAN ;BIR/RGY,PR-COMPILE MAN LST FROM WRD LIST ;27 NOV 95 / 12:57 PM
- ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- ;
- START S Y=1 W !!,"Run manufacturing list for DATE: TODAY//" R X:DTIME G:'$T Q S:X="" X="T" G Q:X["^" I X'["?" S %DT="EX" D ^%DT
- G:Y<1 START
- I X["?" S HELP="MLL" D ^PSIVHLP S X="?" D ^%DT G START
- S PSIVDT=Y\1 D ^PSIVWL1 G:'$D(PSIVOD)!('$D(PSIVCD)) Q
- I PSIVPR'=ION D QUE G Q
- DEQ ;MANUFACTURING LIST START HERE
- L +^PS(55,"PSIVWLM",PSIVSN):1 E W:$Y @IOF W !!,"****WARNING --- MANUFACTURING LIST NOT RUN****" G Q
- S PSIVT="" F I=0:0 S PSIVT=$O(PSIVOD(PSIVT)) Q:PSIVT="" K ^PS(55,"PSIVWLM",PSIVSN,PSIVT_PSIVOD(PSIVT)) S WRD="",PSIVGL1="PSIVWLM",PSIVGL2=PSIVT_PSIVOD(PSIVT) F I=0:0 S WRD=$O(^PS(55,"PSIVWL",PSIVSN,WRD)) Q:WRD="" D RGY
- S PSIVTTM="" F JJ=0:0 S PSIVTTM=$O(PSIVOD(PSIVTTM)) Q:PSIVTTM="" S PSIVGL2=PSIVTTM_PSIVOD(PSIVTTM) D ENT^PSIVMAN1
- Q L -^PS(55,"PSIVWLM",PSIVSN) W:'$D(PSIVPR)&($Y) @IOF S:$D(ZTQUEUED) ZTREQ="@"
- K D,DA,JJ,JJ1,NOFLG,ON,P,PSCT,PSIVDT,PSIVOD,PSIVMT,PSIVGL1,PSIVGL2,PSIVSL,WRD,PSIVT,PSIVTTM,%,%T,%DT,DFN,I,X,Y,ZTM,ZTSK,ADD,PSIV1,PSIV,IOP,PSIVCD,PSIVT,TOTAL,VAERR,Z D ENIVKV^PSGSETU Q
- RGY F DFN=0:0 S DFN=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN)) Q:'DFN D RGY1
- Q
- RGY1 F ON=0:0 S ON=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN,ON)) Q:'ON S PSIVTTM=+^(ON)_"^"_WRD I PSIVTTM D SETP I "EOHPD"'[P(17) D ENS
- Q
- SETP S Y=^PS(55,DFN,"IV",ON,0) F X=1:1:23 S P(X)=$P(Y,"^",X)
- Q
- QUE S ZTIO=PSIVPR,ZTDESC="PRINT IV MANUFACTURING LIST",ZTRTN="DEQ^PSIVMAN",PSIVT="" F I=0:0 S PSIVT=$O(PSIVMT(PSIVT)) Q:PSIVT="" S (ZTSAVE("PSIVCD("""_PSIVT_""")"),ZTSAVE("PSIVMT("""_PSIVT_""")"),ZTSAVE("PSIVOD("""_PSIVT_""")"))=""
- F X="PSIVSN","PSIVDT","PSIVSITE","PSJSYSW0","PSJSYSP0","PSJSYSU" S ZTSAVE(X)=""
- D ^%ZTLOAD W:$D(ZTSK) !,"Queued." Q
- ;
- ENS ;
- S P(4)=$P(^PS(55,DFN,"IV",ON,0),"^",4)
- SETS S PSIVSOL=$S($D(^(+$O(^PS(55,DFN,"IV",ON,"SOL",0)),0)):^(0),1:"zz7") I PSIVSOL S PSIVSOL=$S($D(^PS(52.7,+PSIVSOL,0)):$E($P(^(0),"^"),1,10)_"^"_$P(PSIVSOL,"^",2),1:+PSIVSOL)_"^"_7_";"_+PSIVSOL
- ;
- SETA S PSIVADD=$S($D(^(+$O(^PS(55,DFN,"IV",ON,"AD",0)),0)):^(0),1:"zz6") I PSIVADD S PSIVADD=$S($D(^PS(52.6,+PSIVADD,0)):$E($P(^(0),"^"),1,10)_"^"_$P(PSIVADD,"^",2),1:+PSIVADD)_"^"_6_";"_+PSIVADD
- S ^(0)=$S($D(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,P(4),$S("PS"[P(4)!(P(23)="P"!(P(23)="S")):PSIVADD,1:PSIVSOL),0)):+^(0),1:0)+PSIVTTM,^($S("PS"[P(4)!(P(23)="P"!(P(23)="S")):PSIVSOL,1:PSIVADD),DFN,ON)=PSIVTTM
- K PSIVTTM,PSIVADD,PSIVSOL Q
- PSIVMAN ;BIR/RGY,PR-COMPILE MAN LST FROM WRD LIST ;27 NOV 95 / 12:57 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- +2 ;
- START SET Y=1
- WRITE !!,"Run manufacturing list for DATE: TODAY//"
- READ X:DTIME
- IF '$TEST
- GOTO Q
- IF X=""
- SET X="T"
- IF X["^"
- GOTO Q
- IF X'["?"
- SET %DT="EX"
- DO ^%DT
- +1 IF Y<1
- GOTO START
- +2 IF X["?"
- SET HELP="MLL"
- DO ^PSIVHLP
- SET X="?"
- DO ^%DT
- GOTO START
- +3 SET PSIVDT=Y\1
- DO ^PSIVWL1
- IF '$DATA(PSIVOD)!('$DATA(PSIVCD))
- GOTO Q
- +4 IF PSIVPR'=ION
- DO QUE
- GOTO Q
- DEQ ;MANUFACTURING LIST START HERE
- +1 LOCK +^PS(55,"PSIVWLM",PSIVSN):1
- IF '$TEST
- IF $Y
- WRITE @IOF
- WRITE !!,"****WARNING --- MANUFACTURING LIST NOT RUN****"
- GOTO Q
- +2 SET PSIVT=""
- FOR I=0:0
- SET PSIVT=$ORDER(PSIVOD(PSIVT))
- IF PSIVT=""
- QUIT
- KILL ^PS(55,"PSIVWLM",PSIVSN,PSIVT_PSIVOD(PSIVT))
- SET WRD=""
- SET PSIVGL1="PSIVWLM"
- SET PSIVGL2=PSIVT_PSIVOD(PSIVT)
- FOR I=0:0
- SET WRD=$ORDER(^PS(55,"PSIVWL",PSIVSN,WRD))
- IF WRD=""
- QUIT
- DO RGY
- +3 SET PSIVTTM=""
- FOR JJ=0:0
- SET PSIVTTM=$ORDER(PSIVOD(PSIVTTM))
- IF PSIVTTM=""
- QUIT
- SET PSIVGL2=PSIVTTM_PSIVOD(PSIVTTM)
- DO ENT^PSIVMAN1
- Q LOCK -^PS(55,"PSIVWLM",PSIVSN)
- IF '$DATA(PSIVPR)&($Y)
- WRITE @IOF
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +1 KILL D,DA,JJ,JJ1,NOFLG,ON,P,PSCT,PSIVDT,PSIVOD,PSIVMT,PSIVGL1,PSIVGL2,PSIVSL,WRD,PSIVT,PSIVTTM,%,%T,%DT,DFN,I,X,Y,ZTM,ZTSK,ADD,PSIV1,PSIV,IOP,PSIVCD,PSIVT,TOTAL,VAERR,Z
- DO ENIVKV^PSGSETU
- QUIT
- RGY FOR DFN=0:0
- SET DFN=$ORDER(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN))
- IF 'DFN
- QUIT
- DO RGY1
- +1 QUIT
- RGY1 FOR ON=0:0
- SET ON=$ORDER(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN,ON))
- IF 'ON
- QUIT
- SET PSIVTTM=+^(ON)_"^"_WRD
- IF PSIVTTM
- DO SETP
- IF "EOHPD"'[P(17)
- DO ENS
- +1 QUIT
- SETP SET Y=^PS(55,DFN,"IV",ON,0)
- FOR X=1:1:23
- SET P(X)=$PIECE(Y,"^",X)
- +1 QUIT
- QUE SET ZTIO=PSIVPR
- SET ZTDESC="PRINT IV MANUFACTURING LIST"
- SET ZTRTN="DEQ^PSIVMAN"
- SET PSIVT=""
- FOR I=0:0
- SET PSIVT=$ORDER(PSIVMT(PSIVT))
- IF PSIVT=""
- QUIT
- SET (ZTSAVE("PSIVCD("""_PSIVT_""")"),ZTSAVE("PSIVMT("""_PSIVT_""")"),ZTSAVE("PSIVOD("""_PSIVT_""")"))=""
- +1 FOR X="PSIVSN","PSIVDT","PSIVSITE","PSJSYSW0","PSJSYSP0","PSJSYSU"
- SET ZTSAVE(X)=""
- +2 DO ^%ZTLOAD
- IF $DATA(ZTSK)
- WRITE !,"Queued."
- QUIT
- +3 ;
- ENS ;
- +1 SET P(4)=$PIECE(^PS(55,DFN,"IV",ON,0),"^",4)
- SETS SET PSIVSOL=$SELECT($DATA(^(+$ORDER(^PS(55,DFN,"IV",ON,"SOL",0)),0)):^(0),1:"zz7")
- IF PSIVSOL
- SET PSIVSOL=$SELECT($DATA(^PS(52.7,+PSIVSOL,0)):$EXTRACT($PIECE(^(0),"^"),1,10)_"^"_$PIECE(PSIVSOL,"^",2),1:+PSIVSOL)_"^"_7_";"_+PSIVSOL
- +1 ;
- SETA SET PSIVADD=$SELECT($DATA(^(+$ORDER(^PS(55,DFN,"IV",ON,"AD",0)),0)):^(0),1:"zz6")
- IF PSIVADD
- SET PSIVADD=$SELECT($DATA(^PS(52.6,+PSIVADD,0)):$EXTRACT($PIECE(^(0),"^"),1,10)_"^"_$PIECE(PSIVADD,"^",2),1:+PSIVADD)_"^"_6_";"_+PSIVADD
- +1 SET ^(0)=$SELECT($DATA(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,P(4),$SELECT("PS"[P(4)!(P(23)="P"!(P(23)="S")):PSIVADD,1:PSIVSOL),0)):+^(0),1:0)+PSIVTTM
- SET ^($SELECT("PS"[P(4)!(P(23)="P"!(P(23)="S")):PSIVSOL,1:PSIVADD),DFN,ON)=PSIVTTM
- +2 KILL PSIVTTM,PSIVADD,PSIVSOL
- QUIT
