- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXUNREL 6506 printed Apr 23, 2025@17:59:48 Page 2
- 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
