PSXUNREL ;BIR/WPB-Report of Rx's Not Released by the Vendor ;29 Jun 2001 2:34 PM
;;2.0;CMOP;**23,28,34,38**;11 Apr 97
;Reference to CMOP^PSNAPIS supported by DBIA #2574
EN I '$D(^PSX(552.4,"AR")) W !,"All Rx's have been released." Q
D EX
S DIC=552.1,DIC(0)="AEQMZ",DIC("A")="Select CMOP Batch # or RETURN for all: "
D ^DIC K DIC I $D(DUOUT)!($D(DTOUT))!(X["^") G EX
K DIRUT,DTOUT
S:+Y>0 PSXBEG=+Y K Y,X
S PSXANS=""
I $G(PSXBEG) G DEV
Q1 S DIR(0)="S^C:Controlled Subs;N:Non-Controlled Subs;B:Both",DIR("?")="Enter ""C"" to report controlled substances, ""N"" for non-controlled substances or ""B"" to include both."
D ^DIR K DIR S PSXANS=$G(Y) I $D(DIRUT) K Y,X D EX G EN
D DATE Q:$G(STOP)
DEV S %ZIS="Q",%ZIS("B")="HOME" D ^%ZIS S PSXLION=ION,PGL=($G(IOSL)-2) I POP W !,"NO DEVICE SELECTED" G EX
I $D(IO("Q")) D QUE,EX Q
G:$G(PSXBEG)>0 JOB
D JOBA,EX
Q
DATE ;DATE SECTION
K STOP
S %DT="AEXT",%DT("A")="Enter to BEGIN SUMMARY: ",%DT(0)="-DT",%DT("B")="TODAY"
D ^%DT K %DT("A")
I Y<0!($D(DTOUT)) S STOP=1 Q
S START=Y
S %DT("A")="Enter date to END SUMMARY: ",%DT(0)="-DT",%DT("B")="TODAY" D ^%DT
K %DT
I Y<0!($D(DTOUT)) S STOP=1 Q
S END=Y\1+.24
I END<START W !,"Ending date must follow starting date!" G DATE
DIVISION ;
S ZZFAC1=0,DIC=552,DIC(0)="AEQMZ",DIC("A")="Select FACILITY or RETURN for all: "
D ^DIC K DIC I $D(DUOUT)!($D(DTOUT))!(X["^") G EX
S:$G(Y)'>0 ALL=1,FAC1=0 Q:$G(Y)'>0
I +Y>0 S ZZFAC1=$$GET1^DIQ(552,+Y,5)
; getting site/divnum
I ZZFAC1'>0 S XX=$P(Y,U,2)_",",ZZFAC1=$$GET1^DIQ(4,XX,99)
K Y,X,DIC,DUOUT,DTOUT
Q
QUE S ZTRTN=$S($G(PSXBEG)>0:"JOB^PSXUNREL",$G(PSXBEG)="":"JOBA^PSXUNREL",1:""),ZTDESC="CMOP Unreleased Rx Report",ZTIO=PSXLION
F X="PSXBEG","PGL","PSXANS","START","END","ZZFAC1" S ZTSAVE(X)=""
D ^%ZTLOAD
I $D(ZTSK)[0 W !!,"Job Canceled"
E W !!,"Job Queued"
Q
;Called by Taskman to run Report of Rx's not released by Vendor
JOB S:$D(ZTQUEUED) ZTREQ="@"
I '$D(ZTQUEUED) U IO
I $G(PSXBEG) S RC5=$O(^PSX(552.4,"B",PSXBEG,"")),REC5=$P(^PSX(552.4,RC5,0),"^",1),REC5=REC5-1,PSXEND=REC5+1 D JOB1 G:$G(STOP) EX
I $G(IOST)["C-" S DIR(0)="E",DIR("A")="<CR> - CONTINUE" D ^DIR G EX
G EX
Q
;Called by Taskman to run Report of Rx's not released by Vendor
; information stored for printing
; S ^TMP($J,"PSX",BAT)=ATM_U_TDTM_U_REC5
; S ^TMP($J,"PSX",BAT,"TYP")=PSXTYP
; S ^TMP($J,"PSX",BAT,ORDER,RX,FILL)=VAPRT_U_DRGID
;
JOBA S REC5=0,PSXEND=999999999
S:$D(ZTQUEUED) ZTREQ="@"
I '$D(ZTQUEUED) U IO
JOB1 ;(515,"AR",IEN514,RXN)
K ^TMP($J,"PSX")
S $P(LINE,"-",IOM-1)=""
F S REC5=$O(^PSX(552.4,"AR",REC5)) Q:REC5'>0!(REC5>PSXEND) D
.I '$D(^PSX(552.1,REC5)) Q
.I $D(START) I START'=0 S ZZCHKDT=$P(^PSX(552.1,REC5,0),U,6) Q:((ZZCHKDT<START)!(ZZCHKDT>END))
.I $D(ZZFAC1) I ZZFAC1>0 Q:ZZFAC1'=$P(^PSX(552.1,REC5,0),"-")
.S ATM=$P($G(^PSX(552.1,REC5,0)),U,6) Q:$G(ATM)']""
.S BAT=$P(^PSX(552.1,REC5,0),U,1)
.S TDTM=$P(^PSX(552.1,REC5,0),U,3),REC4=$O(^PSX(552.4,"B",REC5,""))
.S ^TMP($J,"PSX",BAT)=ATM_U_TDTM_U_REC5
.S RX="" F S RX=$O(^PSX(552.4,"AR",REC5,RX)) Q:RX="" D JOB2
.I '$D(^TMP($J,"PSX",BAT,"TYP")) K ^TMP($J,"PSX",BAT)
.S:$D(DIRUT) REC5=99999999999999
D JOB3
K REC,PSXEND,PSXBEG,AREC,BAT,TDTM,ATM,OLDBAT,RECD,DRGID,FILL
K SITEN,ST,SITE,PHAR,LCNT,LINE,REC4,REC5,RC5,DIRUT,RX
Q
JOB2 ;store information
S RECD=$O(^PSX(552.4,REC4,1,"B",RX,"")) Q:$G(RECD)=""
S PSXTYP=$P($G(^PSX(552.4,REC4,1,RECD,0)),U,14)
I $G(PSXANS)="N",PSXTYP=1 Q
I $G(PSXANS)="C",PSXTYP="" Q
Q:$D(DIRUT)
S DRGID=$P(^PSX(552.4,REC4,1,RECD,0),U,4),(NDFPTR,VAPRT)=""
D ORDNUM
S ORDER=$S($L(CORDER(1)):CORDER(1),1:"NONE")
I $G(DRGID)]"" S VAPRT=$$CMOP^PSNAPIS(DRGID)
S FILL=$P(^PSX(552.4,REC4,1,RECD,0),U,12)
S VAPRT=$G(VAPRT)
S ^TMP($J,"PSX",BAT,ORDER,RX,FILL)=VAPRT_U_DRGID
I $G(^TMP($J,"PSX",BAT,"TYP")) Q
S ^TMP($J,"PSX",BAT,"TYP")=PSXTYP
Q
JOB3 ;Print records from ^TMP
K STOP
I '$D(^TMP($J,"PSX")) D G EX
.W @IOF,!!,?15,"NO UNRELEASED DATA TO PRINT",!!
. I $E(IOST)="C" S DIR(0)="E",DIR("A")="<cr> - continue" D ^DIR K DIR
S BAT="" F S BAT=$O(^TMP($J,"PSX",BAT)) Q:BAT="" S ZN=^(BAT) D Q:$G(STOP)
. S ATM=$P(ZN,U),TDTM=$P(ZN,U,2),REC5=$P(ZN,U,3)
. D HDR,ORDER,PG1
Q
ORDER ;Print by order,rx,fill
S ORDER=""
F S ORDER=$O(^TMP($J,"PSX",BAT,ORDER)) Q:ORDER="" S RX="" D Q:$G(STOP)
. F S RX=$O(^TMP($J,"PSX",BAT,ORDER,RX)) Q:RX="" S FILL="" D Q:$G(STOP)
..F S FILL=$O(^TMP($J,"PSX",BAT,ORDER,RX,FILL)) Q:FILL="" S ZN=^(FILL) D Q:$G(STOP)
... S VAPRT=$P(ZN,U),DRGID=$P(ZN,U,2)
... W !,ORDER,?18,RX,?28,FILL,?33,$E($G(VAPRT),1,35),?70,DRGID
... D PG
Q
ORDNUM ;Return Order Number
K CORDER
S CORDER=BAT,CORDER(1)=""
F S CORDER=$O(^PSX(552.2,"B",CORDER)) D Q:((CORDER="")!(CORDER(1)'=""))
.I $P(CORDER,"-",1,2)'=BAT S CORDER="" Q
.S ZZNODE=$O(^PSX(552.2,"B",CORDER,0)) Q:ZZNODE<1
.S:$D(^PSX(552.2,"AC",ZZNODE,RX)) CORDER(1)=CORDER
Q
HDR W @IOF
D NOW^%DTC
S SITEN=+BAT
;N X,Y S DIC=4,DIC(0)="MNZ",X=SITEN S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S SITE=$S($G(Y)]"":$P(Y,"^",2),1:"UNKNOWN") K X,Y,DIC ;****DOD L1
N X,Y S X=SITEN,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) AGNCY="DMIS",X=$E(X,2,99) S SITE=$$IEN^XUMF(4,AGNCY,X),SITE=$S($G(SITE)]"":$$NAME^XUAF4(SITE),1:"UNKNOWN") K X,Y,AGNCY ;****DOD L1
S PHAR=$P(^PSX(552.1,REC5,"P"),U,1)
S PSXTYP=^TMP($J,"PSX",BAT,"TYP")
S PSXTYP=$S(+PSXTYP:"Controlled Substance",1:"Non-Controlled Substance")
W !,?15,"Report of Unreleased Rxs for Transmission ",BAT
W !,?23,"Printed : ",$$FMTE^XLFDT(%,"1P"),!
W !,"Facility: ",SITE,?41,"Pharmacy Division: ",PHAR
W !,"Transmitted: ",$$FMTE^XLFDT(TDTM,"1P"),?41,"Received: ",$$FMTE^XLFDT(ATM,"1P")
W !,"Batch Type: ",PSXTYP,!!
W "ORDER #",?18,"RX NUMBER",?28,"FILL",?33,"DRUG NAME",?70,"DRUG ID",!,LINE
W !
Q
PG ;line handler
I (($Y+3)<IOSL) Q
I $G(IOST)["P-" D HDR Q
S DIR(0)="E" D ^DIR K DIR,DIR(0) S:$D(DIRUT) STOP=1
K DIROUT,DTOUT,DUOUT,DIRUT
D:'$G(STOP) HDR
Q
PG1 ;
I $E(IOST)'="C" Q
K DIR
S DIR(0)="E" D ^DIR K DIR,DIR(0) S:$D(DIRUT) STOP=1
K DIROUT,DTOUT,DUOUT,DIRUT
Q
EX ;
K LINE,PHAR,BAT,SITE,OLDBAT,REC,TDTM,SUB,RECD,DRGID,FILL,LCNT,RCD,%,SITEN,X,ST,ATM,%,%ZIS,PSXLION,ZTDESC,ZTIO,ZTRTN,ZTSAVE("PSXBEG"),ZTSK
K DUOUT,DTOUT,X,Y,RC5,REC4,DIROUT,DIR,DIR(0),ZTQUEUED,STOP,PSXANS,VAPRT,NDFPTR
K FAC1,START,END,PSXTYP,STOP,PSXBEG,CORDER
K ALL,ORDER,PGL,ZN,ZZCHKDT,ZZFAC,ZZNODE,ZZXC,ZZXX,ZZFAC1
K ^TMP($J,"PSX")
W @IOF
D ^%ZISC
Q
PSXUNREL ;BIR/WPB-Report of Rx's Not Released by the Vendor ;29 Jun 2001 2:34 PM
+1 ;;2.0;CMOP;**23,28,34,38**;11 Apr 97
+2 ;Reference to CMOP^PSNAPIS supported by DBIA #2574
EN IF '$DATA(^PSX(552.4,"AR"))
WRITE !,"All Rx's have been released."
QUIT
+1 DO EX
+2 SET DIC=552.1
SET DIC(0)="AEQMZ"
SET DIC("A")="Select CMOP Batch # or RETURN for all: "
+3 DO ^DIC
KILL DIC
IF $DATA(DUOUT)!($DATA(DTOUT))!(X["^")
GOTO EX
+4 KILL DIRUT,DTOUT
+5 IF +Y>0
SET PSXBEG=+Y
KILL Y,X
+6 SET PSXANS=""
+7 IF $GET(PSXBEG)
GOTO DEV
Q1 SET DIR(0)="S^C:Controlled Subs;N:Non-Controlled Subs;B:Both"
SET DIR("?")="Enter ""C"" to report controlled substances, ""N"" for non-controlled substances or ""B"" to include both."
+1 DO ^DIR
KILL DIR
SET PSXANS=$GET(Y)
IF $DATA(DIRUT)
KILL Y,X
DO EX
GOTO EN
+2 DO DATE
IF $GET(STOP)
QUIT
DEV SET %ZIS="Q"
SET %ZIS("B")="HOME"
DO ^%ZIS
SET PSXLION=ION
SET PGL=($GET(IOSL)-2)
IF POP
WRITE !,"NO DEVICE SELECTED"
GOTO EX
+1 IF $DATA(IO("Q"))
DO QUE
DO EX
QUIT
+2 IF $GET(PSXBEG)>0
GOTO JOB
+3 DO JOBA
DO EX
+4 QUIT
DATE ;DATE SECTION
+1 KILL STOP
+2 SET %DT="AEXT"
SET %DT("A")="Enter to BEGIN SUMMARY: "
SET %DT(0)="-DT"
SET %DT("B")="TODAY"
+3 DO ^%DT
KILL %DT("A")
+4 IF Y<0!($DATA(DTOUT))
SET STOP=1
QUIT
+5 SET START=Y
+6 SET %DT("A")="Enter date to END SUMMARY: "
SET %DT(0)="-DT"
SET %DT("B")="TODAY"
DO ^%DT
+7 KILL %DT
+8 IF Y<0!($DATA(DTOUT))
SET STOP=1
QUIT
+9 SET END=Y\1+.24
+10 IF END<START
WRITE !,"Ending date must follow starting date!"
GOTO DATE
DIVISION ;
+1 SET ZZFAC1=0
SET DIC=552
SET DIC(0)="AEQMZ"
SET DIC("A")="Select FACILITY or RETURN for all: "
+2 DO ^DIC
KILL DIC
IF $DATA(DUOUT)!($DATA(DTOUT))!(X["^")
GOTO EX
+3 IF $GET(Y)'>0
SET ALL=1
SET FAC1=0
IF $GET(Y)'>0
QUIT
+4 IF +Y>0
SET ZZFAC1=$$GET1^DIQ(552,+Y,5)
+5 ; getting site/divnum
+6 IF ZZFAC1'>0
SET XX=$PIECE(Y,U,2)_","
SET ZZFAC1=$$GET1^DIQ(4,XX,99)
+7 KILL Y,X,DIC,DUOUT,DTOUT
+8 QUIT
QUE SET ZTRTN=$SELECT($GET(PSXBEG)>0:"JOB^PSXUNREL",$GET(PSXBEG)="":"JOBA^PSXUNREL",1:"")
SET ZTDESC="CMOP Unreleased Rx Report"
SET ZTIO=PSXLION
+1 FOR X="PSXBEG","PGL","PSXANS","START","END","ZZFAC1"
SET ZTSAVE(X)=""
+2 DO ^%ZTLOAD
+3 IF $DATA(ZTSK)[0
WRITE !!,"Job Canceled"
+4 IF '$TEST
WRITE !!,"Job Queued"
+5 QUIT
+6 ;Called by Taskman to run Report of Rx's not released by Vendor
JOB IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 IF '$DATA(ZTQUEUED)
USE IO
+2 IF $GET(PSXBEG)
SET RC5=$ORDER(^PSX(552.4,"B",PSXBEG,""))
SET REC5=$PIECE(^PSX(552.4,RC5,0),"^",1)
SET REC5=REC5-1
SET PSXEND=REC5+1
DO JOB1
IF $GET(STOP)
GOTO EX
+3 IF $GET(IOST)["C-"
SET DIR(0)="E"
SET DIR("A")="<CR> - CONTINUE"
DO ^DIR
GOTO EX
+4 GOTO EX
+5 QUIT
+6 ;Called by Taskman to run Report of Rx's not released by Vendor
+7 ; information stored for printing
+8 ; S ^TMP($J,"PSX",BAT)=ATM_U_TDTM_U_REC5
+9 ; S ^TMP($J,"PSX",BAT,"TYP")=PSXTYP
+10 ; S ^TMP($J,"PSX",BAT,ORDER,RX,FILL)=VAPRT_U_DRGID
+11 ;
JOBA SET REC5=0
SET PSXEND=999999999
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 IF '$DATA(ZTQUEUED)
USE IO
JOB1 ;(515,"AR",IEN514,RXN)
+1 KILL ^TMP($JOB,"PSX")
+2 SET $PIECE(LINE,"-",IOM-1)=""
+3 FOR
SET REC5=$ORDER(^PSX(552.4,"AR",REC5))
IF REC5'>0!(REC5>PSXEND)
QUIT
Begin DoDot:1
+4 IF '$DATA(^PSX(552.1,REC5))
QUIT
+5 IF $DATA(START)
IF START'=0
SET ZZCHKDT=$PIECE(^PSX(552.1,REC5,0),U,6)
IF ((ZZCHKDT<START)!(ZZCHKDT>END))
QUIT
+6 IF $DATA(ZZFAC1)
IF ZZFAC1>0
IF ZZFAC1'=$PIECE(^PSX(552.1,REC5,0),"-")
QUIT
+7 SET ATM=$PIECE($GET(^PSX(552.1,REC5,0)),U,6)
IF $GET(ATM)']""
QUIT
+8 SET BAT=$PIECE(^PSX(552.1,REC5,0),U,1)
+9 SET TDTM=$PIECE(^PSX(552.1,REC5,0),U,3)
SET REC4=$ORDER(^PSX(552.4,"B",REC5,""))
+10 SET ^TMP($JOB,"PSX",BAT)=ATM_U_TDTM_U_REC5
+11 SET RX=""
FOR
SET RX=$ORDER(^PSX(552.4,"AR",REC5,RX))
IF RX=""
QUIT
DO JOB2
+12 IF '$DATA(^TMP($JOB,"PSX",BAT,"TYP"))
KILL ^TMP($JOB,"PSX",BAT)
+13 IF $DATA(DIRUT)
SET REC5=99999999999999
End DoDot:1
+14 DO JOB3
+15 KILL REC,PSXEND,PSXBEG,AREC,BAT,TDTM,ATM,OLDBAT,RECD,DRGID,FILL
+16 KILL SITEN,ST,SITE,PHAR,LCNT,LINE,REC4,REC5,RC5,DIRUT,RX
+17 QUIT
JOB2 ;store information
+1 SET RECD=$ORDER(^PSX(552.4,REC4,1,"B",RX,""))
IF $GET(RECD)=""
QUIT
+2 SET PSXTYP=$PIECE($GET(^PSX(552.4,REC4,1,RECD,0)),U,14)
+3 IF $GET(PSXANS)="N"
IF PSXTYP=1
QUIT
+4 IF $GET(PSXANS)="C"
IF PSXTYP=""
QUIT
+5 IF $DATA(DIRUT)
QUIT
+6 SET DRGID=$PIECE(^PSX(552.4,REC4,1,RECD,0),U,4)
SET (NDFPTR,VAPRT)=""
+7 DO ORDNUM
+8 SET ORDER=$SELECT($LENGTH(CORDER(1)):CORDER(1),1:"NONE")
+9 IF $GET(DRGID)]""
SET VAPRT=$$CMOP^PSNAPIS(DRGID)
+10 SET FILL=$PIECE(^PSX(552.4,REC4,1,RECD,0),U,12)
+11 SET VAPRT=$GET(VAPRT)
+12 SET ^TMP($JOB,"PSX",BAT,ORDER,RX,FILL)=VAPRT_U_DRGID
+13 IF $GET(^TMP($JOB,"PSX",BAT,"TYP"))
QUIT
+14 SET ^TMP($JOB,"PSX",BAT,"TYP")=PSXTYP
+15 QUIT
JOB3 ;Print records from ^TMP
+1 KILL STOP
+2 IF '$DATA(^TMP($JOB,"PSX"))
Begin DoDot:1
+3 WRITE @IOF,!!,?15,"NO UNRELEASED DATA TO PRINT",!!
+4 IF $EXTRACT(IOST)="C"
SET DIR(0)="E"
SET DIR("A")="<cr> - continue"
DO ^DIR
KILL DIR
End DoDot:1
GOTO EX
+5 SET BAT=""
FOR
SET BAT=$ORDER(^TMP($JOB,"PSX",BAT))
IF BAT=""
QUIT
SET ZN=^(BAT)
Begin DoDot:1
+6 SET ATM=$PIECE(ZN,U)
SET TDTM=$PIECE(ZN,U,2)
SET REC5=$PIECE(ZN,U,3)
+7 DO HDR
DO ORDER
DO PG1
End DoDot:1
IF $GET(STOP)
QUIT
+8 QUIT
ORDER ;Print by order,rx,fill
+1 SET ORDER=""
+2 FOR
SET ORDER=$ORDER(^TMP($JOB,"PSX",BAT,ORDER))
IF ORDER=""
QUIT
SET RX=""
Begin DoDot:1
+3 FOR
SET RX=$ORDER(^TMP($JOB,"PSX",BAT,ORDER,RX))
IF RX=""
QUIT
SET FILL=""
Begin DoDot:2
+4 FOR
SET FILL=$ORDER(^TMP($JOB,"PSX",BAT,ORDER,RX,FILL))
IF FILL=""
QUIT
SET ZN=^(FILL)
Begin DoDot:3
+5 SET VAPRT=$PIECE(ZN,U)
SET DRGID=$PIECE(ZN,U,2)
+6 WRITE !,ORDER,?18,RX,?28,FILL,?33,$EXTRACT($GET(VAPRT),1,35),?70,DRGID
+7 DO PG
End DoDot:3
IF $GET(STOP)
QUIT
End DoDot:2
IF $GET(STOP)
QUIT
End DoDot:1
IF $GET(STOP)
QUIT
+8 QUIT
ORDNUM ;Return Order Number
+1 KILL CORDER
+2 SET CORDER=BAT
SET CORDER(1)=""
+3 FOR
SET CORDER=$ORDER(^PSX(552.2,"B",CORDER))
Begin DoDot:1
+4 IF $PIECE(CORDER,"-",1,2)'=BAT
SET CORDER=""
QUIT
+5 SET ZZNODE=$ORDER(^PSX(552.2,"B",CORDER,0))
IF ZZNODE<1
QUIT
+6 IF $DATA(^PSX(552.2,"AC",ZZNODE,RX))
SET CORDER(1)=CORDER
End DoDot:1
IF ((CORDER="")!(CORDER(1)'=""))
QUIT
+7 QUIT
HDR WRITE @IOF
+1 DO NOW^%DTC
+2 SET SITEN=+BAT
+3 ;N X,Y S DIC=4,DIC(0)="MNZ",X=SITEN S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S SITE=$S($G(Y)]"":$P(Y,"^",2),1:"UNKNOWN") K X,Y,DIC ;****DOD L1
+4 ;****DOD L1
NEW X,Y
SET X=SITEN
SET AGNCY="VASTANUM"
IF $DATA(^PSX(552,"D",X))
SET AGNCY="DMIS"
SET X=$EXTRACT(X,2,99)
SET SITE=$$IEN^XUMF(4,AGNCY,X)
SET SITE=$SELECT($GET(SITE)]"":$$NAME^XUAF4(SITE),1:"UNKNOWN")
KILL X,Y,AGNCY
+5 SET PHAR=$PIECE(^PSX(552.1,REC5,"P"),U,1)
+6 SET PSXTYP=^TMP($JOB,"PSX",BAT,"TYP")
+7 SET PSXTYP=$SELECT(+PSXTYP:"Controlled Substance",1:"Non-Controlled Substance")
+8 WRITE !,?15,"Report of Unreleased Rxs for Transmission ",BAT
+9 WRITE !,?23,"Printed : ",$$FMTE^XLFDT(%,"1P"),!
+10 WRITE !,"Facility: ",SITE,?41,"Pharmacy Division: ",PHAR
+11 WRITE !,"Transmitted: ",$$FMTE^XLFDT(TDTM,"1P"),?41,"Received: ",$$FMTE^XLFDT(ATM,"1P")
+12 WRITE !,"Batch Type: ",PSXTYP,!!
+13 WRITE "ORDER #",?18,"RX NUMBER",?28,"FILL",?33,"DRUG NAME",?70,"DRUG ID",!,LINE
+14 WRITE !
+15 QUIT
PG ;line handler
+1 IF (($Y+3)<IOSL)
QUIT
+2 IF $GET(IOST)["P-"
DO HDR
QUIT
+3 SET DIR(0)="E"
DO ^DIR
KILL DIR,DIR(0)
IF $DATA(DIRUT)
SET STOP=1
+4 KILL DIROUT,DTOUT,DUOUT,DIRUT
+5 IF '$GET(STOP)
DO HDR
+6 QUIT
PG1 ;
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 KILL DIR
+3 SET DIR(0)="E"
DO ^DIR
KILL DIR,DIR(0)
IF $DATA(DIRUT)
SET STOP=1
+4 KILL DIROUT,DTOUT,DUOUT,DIRUT
+5 QUIT
EX ;
+1 KILL LINE,PHAR,BAT,SITE,OLDBAT,REC,TDTM,SUB,RECD,DRGID,FILL,LCNT,RCD,%,SITEN,X,ST,ATM,%,%ZIS,PSXLION,ZTDESC,ZTIO,ZTRTN,ZTSAVE("PSXBEG"),ZTSK
+2 KILL DUOUT,DTOUT,X,Y,RC5,REC4,DIROUT,DIR,DIR(0),ZTQUEUED,STOP,PSXANS,VAPRT,NDFPTR
+3 KILL FAC1,START,END,PSXTYP,STOP,PSXBEG,CORDER
+4 KILL ALL,ORDER,PGL,ZN,ZZCHKDT,ZZFAC,ZZNODE,ZZXC,ZZXX,ZZFAC1
+5 KILL ^TMP($JOB,"PSX")
+6 WRITE @IOF
+7 DO ^%ZISC
+8 QUIT
