PSOEXRST ;BIR/RTR-Reprint/View HL7 Interface batch ;1/1/96
;;7.0;OUTPATIENT PHARMACY;**26,367**;DEC 1997;Build 62
;External reference to ^PSDRUG supported by DBIA 221
VW D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) G END
START W !!,"Enter a date/time range to see all batches sent to the External Interface."
BEG K ^TMP($J,"PSOHLRES"),^TMP($J,"PSOHLSPR"),^UTILITY($J,"PSOHLEPT"),PSOOUT,DTOUT,PSOLISTY
W ! K %DT S %DT="AEXT",%DT("A")="Start date/time: " D ^%DT K %DT G:Y<0!($D(DTOUT)) END
S (%DT(0),BEGDATE)=Y
W ! S %DT="AEXT",%DT("A")="End date/time: " D ^%DT K %DT G:Y<0!($D(DTOUT)) END
S ENDDATE=Y
S BEGDATE=BEGDATE-.0001,ENDDATE=$S('$P(ENDDATE,".",2):ENDDATE_".9999",1:ENDDATE+.0001),RECNT=1
W !!,"Gathering batches, please wait...",! H 1
F ZZZ=BEGDATE:0 S ZZZ=$O(^PS(52.51,"AS",ZZZ)) Q:'ZZZ!(ZZZ>ENDDATE) D
. F XXX=0:0 S XXX=$O(^PS(52.51,"AS",ZZZ,PSOSITE,XXX)) Q:'XXX D
. . S ^TMP($J,"PSOHLRES",RECNT,ZZZ,PSOSITE,XXX)="",RECNT=RECNT+1
I '$D(^TMP($J,"PSOHLRES")) W $C(7),!!,"There are no printed batches found for that date/time range!",! G BEG
;
H 1 W @IOF W !?1,"BATCH",?10,"QUEUED TO PRINT ON:",?40,"PRINTED BY:",?56,$E($P($G(^PS(59,PSOSITE,0)),"^"),1,23),!
S $P(AA,"-",78)="" W AA,!
F AAA=0:0 S AAA=$O(^TMP($J,"PSOHLRES",AAA)) Q:'AAA!($G(PSOOUT)) D
. S PSIDATE=$O(^TMP($J,"PSOHLRES",AAA,0)),PSODUZ=$O(^TMP($J,"PSOHLRES",AAA,PSIDATE,PSOSITE,0))
. D ZZNAME S Y=PSIDATE X ^DD("DD") S PSODATE=Y,PSOUSER=$S($D(^VA(200,PSODUZ,0)):$P($G(^(0)),"^"),1:"UNKNOWN")
. D:($Y+5)>IOSL Q:$G(PSOOUT) W !?2,AAA,?10,PSODATE,?40,PSOUSER
. . W ! K DIR S DIR(0)="E" D ^DIR K DIR S:'Y PSOOUT=1
. . I Y W @IOF W !?1,"BATCH",?10,"QUEUED TO PRINT ON:",?40,"PRINTED BY:",?56,$E($P($G(^PS(59,PSOSITE,0)),"^"),1,23),!,AA
I $G(PSOOUT),Y="" G END
;
S RECNT=RECNT-1,PSOOUT=0 W ! K DIR
S DIR("A")="Select Batch(s) to "_$S($G(PSOEXVW):"view",1:"reprint"),DIR(0)="L^1:"_RECNT D ^DIR
K DIR I Y["^"!($D(DTOUT))!($D(DUOUT)) W !!?3,"Nothing chosen to "_$S($G(PSOEXVW):"view",1:"reprint"),! G START
S COUNT=1 F ZZ=1:1:$L(Y) S ZZZ=$E(Y,ZZ) I ZZZ="," S COUNT=COUNT+1
S COUNT=COUNT-1 F JJ=1:1:COUNT S RR=$P(Y,",",JJ),^TMP($J,"PSOHLSPR",RR)=""
YLOOP I $G(Y(1)) F PSYLOOP=0:0 S PSYLOOP=$O(Y(PSYLOOP)) Q:'PSYLOOP D
. S COUNT=1 F ZZ=1:1:$L(Y(PSYLOOP)) S ZZZ=$E(Y(PSYLOOP),ZZ) I ZZZ="," S COUNT=COUNT+1
. S COUNT=COUNT-1 F JJ=1:1:COUNT S RR=$P(Y(PSYLOOP),",",JJ),^TMP($J,"PSOHLSPR",RR)=""
W !!,"Batches selected for "_$S($G(PSOEXVW):"Viewing",1:"Reprint")_" are:",!
F ZZZ=0:0 S ZZZ=$O(^TMP($J,"PSOHLSPR",ZZZ)) Q:'ZZZ D
. S PSIDATE=$O(^TMP($J,"PSOHLRES",ZZZ,0)),PSODUZ=$O(^TMP($J,"PSOHLRES",ZZZ,PSIDATE,PSOSITE,0))
. S Y=PSIDATE X ^DD("DD") S PSODATE=Y,PSOUSER=$S($D(^VA(200,PSODUZ,0)):$P($G(^(0)),"^"),1:"UNKNOWN")
. W !,"Batch ",ZZZ," Queued for ",PSODATE," by ",PSOUSER
;
W ! K DIR,DIRUT
I $$GET1^DIQ(59,PSOSITE,134)'="" D I $D(DIRUT) G END
. S DIR("A")="Reprint the FDA Medication Guide",DIR(0)="Y",DIR("B")="No"
. S PSOMGREP=0 D ^DIR K DIR S:$D(DIRUT) PSOREPX=1 Q:$D(DIRUT) S PSOMGREP=Y
;
K PSOLISTY I $G(PSOEXVW) S Y=1 G VWPASS
W ! K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")="Before Reprinting, would you like a list of these prescriptions" D ^DIR K DIR I Y["^"!($D(DTOUT)) W !!?3,"Nothing queued to reprint!",! G START
VWPASS I Y W ! S PSOLISTY=1 S DIR(0)="SB^S:SCREEN;P:PRINTER",DIR("A")="Print list to the screen or to a printer",DIR("B")="Screen" D ^DIR K DIR I $D(DIRUT) W !!?3,"Nothing queued to print!",! G START
I $G(PSOLISTY),Y="P" D ^PSOEXBCH G START
I $G(PSOLISTY) D LIST I $G(PSOOUT)!($G(PSOEXVW)) G START
K DIR W ! S DIR(0)="Y",DIR("B")="Y",DIR("A")="Are you sure you want to Reprint labels" D ^DIR K DIR I Y'=1 W !!,"Nothing queued to Reprint!",! G START
QUE D GETPPL^PSOEXBCH
K PSOEXREX
I '$D(PPLX) W !!,"No Active Labels to Reprint!",! G START
F ZPPL=0:0 S ZPPL=$O(PPLX(ZPPL)) Q:'ZPPL!($G(PSOEXREX)) D
. K PPL,RXPR S PPL=PPLX(ZPPL)
. F PPLPAR=0:0 S PPLPAR=$O(RXPRX(ZPPL,PPLPAR)) Q:'PPLPAR D
. . S RXPR(PPLPAR)=RXPRX(ZPPL,PPLPAR)
. D RACT
. S PSOEXREP=1 D @$S($P($G(PSOPAR),"^",26):"^PSORXL",1:"Q^PSORXL")
I '$G(PSOEXREX) W !!,"LABEL(S) QUEUED TO PRINT!",!
;W ! K %DT D NOW^%DTC S %DT="REAX",%DT(0)=%,%DT("B")="NOW",%DT("A")="Queue labels to reprint at what time: " D ^%DT K %DT I $D(DTOUT)!(Y<0) W !!?3,"Nothing queued to reprint!",! G START
;S PSOSUREP=1,PSORTIME=Y
;W ! S %ZIS("A")="REPRINT LABEL DEVICE: ",%ZIS("B")="",%ZIS="MQN" D ^%ZIS I POP!($E(IOST)["C") G START
;F J=0,1 S @("PSOBAR"_J)="" I $D(^%ZIS(2,^%ZIS(1,IOS,"SUBTYPE"),"BAR"_J)) S @("PSOBAR"_J)=^("BAR"_J)
;S PSOBARS=PSOBAR1]""&(PSOBAR0]"")&$P(PSOPAR,"^",19)
;S PSOREDEV=ION
;S ZTRTN="BEG^PSOSUSRP",ZTDTH=PSORTIME,ZTIO=PSOREDEV,ZTDESC="REPRINT LABELS FROM SUSPENSE"
;F GG="PSOPAR","PSOSYS","PSOSITE","PSOSUREP","PSOBARS","PSOBAR0","PSOBAR1" S:$D(@GG) ZTSAVE(GG)=""
;F NNN=0:0 S NNN=$O(^TMP($J,"PSORESPR",NNN)) Q:'NNN D
;.S PSRDATE=$O(^TMP($J,"PSORES",NNN,0)),PSRDUZ=$O(^TMP($J,"PSORES",NNN,PSRDATE,0)),PSRDIV=$O(^TMP($J,"PSORES",NNN,PSRDATE,PSRDUZ,0))
;.S ^UTILITY($J,"PSOREPT",PSRDATE,PSRDUZ,PSRDIV)=""
;S ZTSAVE("^UTILITY($J,""PSOREPT"",")="" D ^%ZTLOAD
;W !!,"REPRINTED LABELS QUEUED TO PRINT!",!
END K ^TMP($J,"PSOHLRES"),^TMP($J,"PSOHLSPR"),%DT,%ZIS,AA,AAA,BEGDATE,COUNT,DUOUT,DTOUT,ENDDATE,GG,INRX,JJ,LLL,MMM
K NNN,POP,PSIDATE,PSODATE,PSODUZ,PSOREDEV,PSORTIME,PSOSUREP,PSOUSER,PSYLOOP,NM1,NM2,NM3,HLZNAME,ZZNAME,PSOEXREP
K ZPPL,PPLPAR,RXPR,HLZZNAME,HLZZDRUG,HLZZDRUL,PSRDATE,PSRDIV,PSOLISTY,PSRDUZ,RECNT,REDT,REDUZ,RR,SS,XXX,ZZ,ZZZ
K ZZNM,ZZNM1,ZZZ,PSOEXVW,PSEXSTAT,PSX,PPL,PPLX,RXPRX,RXPR,PSOEXREX,PSOMGREP
D ^%ZISC Q
;
LIST F LLL=0:0 S LLL=$O(^TMP($J,"PSOHLSPR",LLL)) Q:'LLL!($G(PSOOUT)) D GETN D
.W ! S DIR(0)="E" D ^DIR K DIR S:'Y PSOOUT=1 Q:$G(PSOOUT) D HEAD S REDT=$O(^TMP($J,"PSOHLRES",LLL,0)),REDUZ=$O(^TMP($J,"PSOHLRES",LLL,REDT,PSOSITE,0)) F SS=0:0 S SS=$O(^PS(52.51,"AS",REDT,PSOSITE,REDUZ,SS)) Q:'SS!($G(PSOOUT)) D
..D:($Y+5)>IOSL HEADONE Q:$G(PSOOUT) I $D(^PS(52.51,SS,0)),$P($G(^(0)),"^",11)=PSOSITE S INRX=$P(^(0),"^") I $D(^PSRX(INRX,0)) D
...;D STAT
...S HLZZNAME=$P($G(^DPT(+$P($G(^PSRX(INRX,0)),"^",2),0)),"^")
...S HLZZDRUG=$P($G(^PSDRUG(+$P($G(^PSRX(INRX,0)),"^",6),0)),"^"),HLZZDRUL=$L($G(HLZZDRUG))
...W !,$P(^PSRX(INRX,0),"^"),?13,$G(HLZZNAME)
...I +$G(HLZZDRUL)<37 W ?44,$G(HLZZDRUG) Q
...W !?38,$G(HLZZDRUG)
I $G(PSOOUT),(Y="") Q
S PSOOUT=0 I Y'=0 W !,"END OF LIST"
Q
HEAD W @IOF W !,"RX #",?13,"PATIENT NAME",?44,"BATCH ",LLL,! F ZZZZ=1:1:78 W "-"
Q
HEADONE S DIR(0)="E" D ^DIR K DIR I 'Y S PSOOUT=1 Q
W @IOF W !,"RX #",?13,"PATIENT NAME",?44,"BATCH ",LLL,! F ZZZZ=1:1:78 W "-"
Q
GETN S NM1=$O(^TMP($J,"PSOHLRES",LLL,0)),NM2=$O(^TMP($J,"PSOHLRES",LLL,NM1,PSOSITE,0)),NM3=$O(^PS(52.51,"AS",NM1,PSOSITE,NM2,0))
S HLZNAME=$P($G(^DPT(+$P($G(^PS(52.51,+$G(NM3),0)),"^",2),0)),"^")
Q
ZZNAME S ZZNM=+$O(^PS(52.51,"AS",PSIDATE,PSOSITE,PSODUZ,0)),ZZNM1=+$P($G(^PS(52.51,ZZNM,0)),"^",2)
S ZZNAME=$P($G(^DPT(ZZNM1,0)),"^")
Q
VIEW ;
S PSOEXVW=1 G VW
;
STAT ;
S PSX=$P($G(^PSRX(INRX,"STA")),"^")
S PSEXSTAT=$S(PSX=0:"ACTIVE",PSX=1:"NON-VERIFIED",PSX=3:"HOLD",PSX=4:"DRUG INTERACTION",PSX=5:"SUSPENDED",PSX=11:"EXPIRED",PSX=12!(PSX=14):"DISCONTINUED",PSX=13:"DELETED",PSX=15:"DISCONTINUED (EDIT)",PSX=16:"PROVIDER HOLD",1:"")
Q
RACT ;Set activity log
N WW,WRX,WRX,WFILL,WWW,WIR
F WW=1:1 S WRX=$P(PPL,",",WW) Q:'WRX D:$G(WRX)
.I '$G(RXPR(WRX)) S WFILL=0 F WWW=0:0 S WWW=$O(^PSRX(WRX,1,WWW)) Q:'WWW S WFILL=WWW S:WWW>5 WFILL=WWW+1
.S WIR=0 F WWW=0:0 S WWW=$O(^PSRX(WRX,"A",WWW)) Q:'WWW S WIR=WWW
.S WIR=WIR+1,^PSRX(WRX,"A",0)="^52.3DA^"_WIR_"^"_WIR
.D NOW^%DTC S ^PSRX(WRX,"A",WIR,0)=%_"^W^"_+$G(DUZ)_"^"_$S($G(RXPR(WRX)):6,1:$G(WFILL))_"^"_"Reprint "_$S($G(RXPR(WRX)):"(PARTIAL) ",1:"")_"(Originally sent to External Interface)"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOEXRST 7825 printed Dec 13, 2024@02:29:22 Page 2
PSOEXRST ;BIR/RTR-Reprint/View HL7 Interface batch ;1/1/96
+1 ;;7.0;OUTPATIENT PHARMACY;**26,367**;DEC 1997;Build 62
+2 ;External reference to ^PSDRUG supported by DBIA 221
VW if '$DATA(PSOPAR)
DO ^PSOLSET
IF '$DATA(PSOPAR)
GOTO END
START WRITE !!,"Enter a date/time range to see all batches sent to the External Interface."
BEG KILL ^TMP($JOB,"PSOHLRES"),^TMP($JOB,"PSOHLSPR"),^UTILITY($JOB,"PSOHLEPT"),PSOOUT,DTOUT,PSOLISTY
+1 WRITE !
KILL %DT
SET %DT="AEXT"
SET %DT("A")="Start date/time: "
DO ^%DT
KILL %DT
if Y<0!($DATA(DTOUT))
GOTO END
+2 SET (%DT(0),BEGDATE)=Y
+3 WRITE !
SET %DT="AEXT"
SET %DT("A")="End date/time: "
DO ^%DT
KILL %DT
if Y<0!($DATA(DTOUT))
GOTO END
+4 SET ENDDATE=Y
+5 SET BEGDATE=BEGDATE-.0001
SET ENDDATE=$SELECT('$PIECE(ENDDATE,".",2):ENDDATE_".9999",1:ENDDATE+.0001)
SET RECNT=1
+6 WRITE !!,"Gathering batches, please wait...",!
HANG 1
+7 FOR ZZZ=BEGDATE:0
SET ZZZ=$ORDER(^PS(52.51,"AS",ZZZ))
if 'ZZZ!(ZZZ>ENDDATE)
QUIT
Begin DoDot:1
+8 FOR XXX=0:0
SET XXX=$ORDER(^PS(52.51,"AS",ZZZ,PSOSITE,XXX))
if 'XXX
QUIT
Begin DoDot:2
+9 SET ^TMP($JOB,"PSOHLRES",RECNT,ZZZ,PSOSITE,XXX)=""
SET RECNT=RECNT+1
End DoDot:2
End DoDot:1
+10 IF '$DATA(^TMP($JOB,"PSOHLRES"))
WRITE $CHAR(7),!!,"There are no printed batches found for that date/time range!",!
GOTO BEG
+11 ;
+12 HANG 1
WRITE @IOF
WRITE !?1,"BATCH",?10,"QUEUED TO PRINT ON:",?40,"PRINTED BY:",?56,$EXTRACT($PIECE($GET(^PS(59,PSOSITE,0)),"^"),1,23),!
+13 SET $PIECE(AA,"-",78)=""
WRITE AA,!
+14 FOR AAA=0:0
SET AAA=$ORDER(^TMP($JOB,"PSOHLRES",AAA))
if 'AAA!($GET(PSOOUT))
QUIT
Begin DoDot:1
+15 SET PSIDATE=$ORDER(^TMP($JOB,"PSOHLRES",AAA,0))
SET PSODUZ=$ORDER(^TMP($JOB,"PSOHLRES",AAA,PSIDATE,PSOSITE,0))
+16 DO ZZNAME
SET Y=PSIDATE
XECUTE ^DD("DD")
SET PSODATE=Y
SET PSOUSER=$SELECT($DATA(^VA(200,PSODUZ,0)):$PIECE($GET(^(0)),"^"),1:"UNKNOWN")
+17 if ($Y+5)>IOSL
Begin DoDot:2
+18 WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
if 'Y
SET PSOOUT=1
+19 IF Y
WRITE @IOF
WRITE !?1,"BATCH",?10,"QUEUED TO PRINT ON:",?40,"PRINTED BY:",?56,$EXTRACT($PIECE($GET(^PS(59,PSOSITE,0)),"^"),1,23),!,AA
End DoDot:2
if $GET(PSOOUT)
QUIT
WRITE !?2,AAA,?10,PSODATE,?40,PSOUSER
End DoDot:1
+20 IF $GET(PSOOUT)
IF Y=""
GOTO END
+21 ;
+22 SET RECNT=RECNT-1
SET PSOOUT=0
WRITE !
KILL DIR
+23 SET DIR("A")="Select Batch(s) to "_$SELECT($GET(PSOEXVW):"view",1:"reprint")
SET DIR(0)="L^1:"_RECNT
DO ^DIR
+24 KILL DIR
IF Y["^"!($DATA(DTOUT))!($DATA(DUOUT))
WRITE !!?3,"Nothing chosen to "_$SELECT($GET(PSOEXVW):"view",1:"reprint"),!
GOTO START
+25 SET COUNT=1
FOR ZZ=1:1:$LENGTH(Y)
SET ZZZ=$EXTRACT(Y,ZZ)
IF ZZZ=","
SET COUNT=COUNT+1
+26 SET COUNT=COUNT-1
FOR JJ=1:1:COUNT
SET RR=$PIECE(Y,",",JJ)
SET ^TMP($JOB,"PSOHLSPR",RR)=""
YLOOP IF $GET(Y(1))
FOR PSYLOOP=0:0
SET PSYLOOP=$ORDER(Y(PSYLOOP))
if 'PSYLOOP
QUIT
Begin DoDot:1
+1 SET COUNT=1
FOR ZZ=1:1:$LENGTH(Y(PSYLOOP))
SET ZZZ=$EXTRACT(Y(PSYLOOP),ZZ)
IF ZZZ=","
SET COUNT=COUNT+1
+2 SET COUNT=COUNT-1
FOR JJ=1:1:COUNT
SET RR=$PIECE(Y(PSYLOOP),",",JJ)
SET ^TMP($JOB,"PSOHLSPR",RR)=""
End DoDot:1
+3 WRITE !!,"Batches selected for "_$SELECT($GET(PSOEXVW):"Viewing",1:"Reprint")_" are:",!
+4 FOR ZZZ=0:0
SET ZZZ=$ORDER(^TMP($JOB,"PSOHLSPR",ZZZ))
if 'ZZZ
QUIT
Begin DoDot:1
+5 SET PSIDATE=$ORDER(^TMP($JOB,"PSOHLRES",ZZZ,0))
SET PSODUZ=$ORDER(^TMP($JOB,"PSOHLRES",ZZZ,PSIDATE,PSOSITE,0))
+6 SET Y=PSIDATE
XECUTE ^DD("DD")
SET PSODATE=Y
SET PSOUSER=$SELECT($DATA(^VA(200,PSODUZ,0)):$PIECE($GET(^(0)),"^"),1:"UNKNOWN")
+7 WRITE !,"Batch ",ZZZ," Queued for ",PSODATE," by ",PSOUSER
End DoDot:1
+8 ;
+9 WRITE !
KILL DIR,DIRUT
+10 IF $$GET1^DIQ(59,PSOSITE,134)'=""
Begin DoDot:1
+11 SET DIR("A")="Reprint the FDA Medication Guide"
SET DIR(0)="Y"
SET DIR("B")="No"
+12 SET PSOMGREP=0
DO ^DIR
KILL DIR
if $DATA(DIRUT)
SET PSOREPX=1
if $DATA(DIRUT)
QUIT
SET PSOMGREP=Y
End DoDot:1
IF $DATA(DIRUT)
GOTO END
+13 ;
+14 KILL PSOLISTY
IF $GET(PSOEXVW)
SET Y=1
GOTO VWPASS
+15 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="N"
SET DIR("A")="Before Reprinting, would you like a list of these prescriptions"
DO ^DIR
KILL DIR
IF Y["^"!($DATA(DTOUT))
WRITE !!?3,"Nothing queued to reprint!",!
GOTO START
VWPASS IF Y
WRITE !
SET PSOLISTY=1
SET DIR(0)="SB^S:SCREEN;P:PRINTER"
SET DIR("A")="Print list to the screen or to a printer"
SET DIR("B")="Screen"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
WRITE !!?3,"Nothing queued to print!",!
GOTO START
+1 IF $GET(PSOLISTY)
IF Y="P"
DO ^PSOEXBCH
GOTO START
+2 IF $GET(PSOLISTY)
DO LIST
IF $GET(PSOOUT)!($GET(PSOEXVW))
GOTO START
+3 KILL DIR
WRITE !
SET DIR(0)="Y"
SET DIR("B")="Y"
SET DIR("A")="Are you sure you want to Reprint labels"
DO ^DIR
KILL DIR
IF Y'=1
WRITE !!,"Nothing queued to Reprint!",!
GOTO START
QUE DO GETPPL^PSOEXBCH
+1 KILL PSOEXREX
+2 IF '$DATA(PPLX)
WRITE !!,"No Active Labels to Reprint!",!
GOTO START
+3 FOR ZPPL=0:0
SET ZPPL=$ORDER(PPLX(ZPPL))
if 'ZPPL!($GET(PSOEXREX))
QUIT
Begin DoDot:1
+4 KILL PPL,RXPR
SET PPL=PPLX(ZPPL)
+5 FOR PPLPAR=0:0
SET PPLPAR=$ORDER(RXPRX(ZPPL,PPLPAR))
if 'PPLPAR
QUIT
Begin DoDot:2
+6 SET RXPR(PPLPAR)=RXPRX(ZPPL,PPLPAR)
End DoDot:2
+7 DO RACT
+8 SET PSOEXREP=1
DO @$SELECT($PIECE($GET(PSOPAR),"^",26):"^PSORXL",1:"Q^PSORXL")
End DoDot:1
+9 IF '$GET(PSOEXREX)
WRITE !!,"LABEL(S) QUEUED TO PRINT!",!
+10 ;W ! K %DT D NOW^%DTC S %DT="REAX",%DT(0)=%,%DT("B")="NOW",%DT("A")="Queue labels to reprint at what time: " D ^%DT K %DT I $D(DTOUT)!(Y<0) W !!?3,"Nothing queued to reprint!",! G START
+11 ;S PSOSUREP=1,PSORTIME=Y
+12 ;W ! S %ZIS("A")="REPRINT LABEL DEVICE: ",%ZIS("B")="",%ZIS="MQN" D ^%ZIS I POP!($E(IOST)["C") G START
+13 ;F J=0,1 S @("PSOBAR"_J)="" I $D(^%ZIS(2,^%ZIS(1,IOS,"SUBTYPE"),"BAR"_J)) S @("PSOBAR"_J)=^("BAR"_J)
+14 ;S PSOBARS=PSOBAR1]""&(PSOBAR0]"")&$P(PSOPAR,"^",19)
+15 ;S PSOREDEV=ION
+16 ;S ZTRTN="BEG^PSOSUSRP",ZTDTH=PSORTIME,ZTIO=PSOREDEV,ZTDESC="REPRINT LABELS FROM SUSPENSE"
+17 ;F GG="PSOPAR","PSOSYS","PSOSITE","PSOSUREP","PSOBARS","PSOBAR0","PSOBAR1" S:$D(@GG) ZTSAVE(GG)=""
+18 ;F NNN=0:0 S NNN=$O(^TMP($J,"PSORESPR",NNN)) Q:'NNN D
+19 ;.S PSRDATE=$O(^TMP($J,"PSORES",NNN,0)),PSRDUZ=$O(^TMP($J,"PSORES",NNN,PSRDATE,0)),PSRDIV=$O(^TMP($J,"PSORES",NNN,PSRDATE,PSRDUZ,0))
+20 ;.S ^UTILITY($J,"PSOREPT",PSRDATE,PSRDUZ,PSRDIV)=""
+21 ;S ZTSAVE("^UTILITY($J,""PSOREPT"",")="" D ^%ZTLOAD
+22 ;W !!,"REPRINTED LABELS QUEUED TO PRINT!",!
END KILL ^TMP($JOB,"PSOHLRES"),^TMP($JOB,"PSOHLSPR"),%DT,%ZIS,AA,AAA,BEGDATE,COUNT,DUOUT,DTOUT,ENDDATE,GG,INRX,JJ,LLL,MMM
+1 KILL NNN,POP,PSIDATE,PSODATE,PSODUZ,PSOREDEV,PSORTIME,PSOSUREP,PSOUSER,PSYLOOP,NM1,NM2,NM3,HLZNAME,ZZNAME,PSOEXREP
+2 KILL ZPPL,PPLPAR,RXPR,HLZZNAME,HLZZDRUG,HLZZDRUL,PSRDATE,PSRDIV,PSOLISTY,PSRDUZ,RECNT,REDT,REDUZ,RR,SS,XXX,ZZ,ZZZ
+3 KILL ZZNM,ZZNM1,ZZZ,PSOEXVW,PSEXSTAT,PSX,PPL,PPLX,RXPRX,RXPR,PSOEXREX,PSOMGREP
+4 DO ^%ZISC
QUIT
+5 ;
LIST FOR LLL=0:0
SET LLL=$ORDER(^TMP($JOB,"PSOHLSPR",LLL))
if 'LLL!($GET(PSOOUT))
QUIT
DO GETN
Begin DoDot:1
+1 WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
if 'Y
SET PSOOUT=1
if $GET(PSOOUT)
QUIT
DO HEAD
SET REDT=$ORDER(^TMP($JOB,"PSOHLRES",LLL,0))
SET REDUZ=$ORDER(^TMP($JOB,"PSOHLRES",LLL,REDT,PSOSITE,0))
FOR SS=0:0
SET SS=$ORDER(^PS(52.51,"AS",REDT,PSOSITE,REDUZ,SS))
if 'SS!($GET(PSOOUT))
QUIT
Begin DoDot:2
+2 if ($Y+5)>IOSL
DO HEADONE
if $GET(PSOOUT)
QUIT
IF $DATA(^PS(52.51,SS,0))
IF $PIECE($GET(^(0)),"^",11)=PSOSITE
SET INRX=$PIECE(^(0),"^")
IF $DATA(^PSRX(INRX,0))
Begin DoDot:3
+3 ;D STAT
+4 SET HLZZNAME=$PIECE($GET(^DPT(+$PIECE($GET(^PSRX(INRX,0)),"^",2),0)),"^")
+5 SET HLZZDRUG=$PIECE($GET(^PSDRUG(+$PIECE($GET(^PSRX(INRX,0)),"^",6),0)),"^")
SET HLZZDRUL=$LENGTH($GET(HLZZDRUG))
+6 WRITE !,$PIECE(^PSRX(INRX,0),"^"),?13,$GET(HLZZNAME)
+7 IF +$GET(HLZZDRUL)<37
WRITE ?44,$GET(HLZZDRUG)
QUIT
+8 WRITE !?38,$GET(HLZZDRUG)
End DoDot:3
End DoDot:2
End DoDot:1
+9 IF $GET(PSOOUT)
IF (Y="")
QUIT
+10 SET PSOOUT=0
IF Y'=0
WRITE !,"END OF LIST"
+11 QUIT
HEAD WRITE @IOF
WRITE !,"RX #",?13,"PATIENT NAME",?44,"BATCH ",LLL,!
FOR ZZZZ=1:1:78
WRITE "-"
+1 QUIT
HEADONE SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET PSOOUT=1
QUIT
+1 WRITE @IOF
WRITE !,"RX #",?13,"PATIENT NAME",?44,"BATCH ",LLL,!
FOR ZZZZ=1:1:78
WRITE "-"
+2 QUIT
GETN SET NM1=$ORDER(^TMP($JOB,"PSOHLRES",LLL,0))
SET NM2=$ORDER(^TMP($JOB,"PSOHLRES",LLL,NM1,PSOSITE,0))
SET NM3=$ORDER(^PS(52.51,"AS",NM1,PSOSITE,NM2,0))
+1 SET HLZNAME=$PIECE($GET(^DPT(+$PIECE($GET(^PS(52.51,+$GET(NM3),0)),"^",2),0)),"^")
+2 QUIT
ZZNAME SET ZZNM=+$ORDER(^PS(52.51,"AS",PSIDATE,PSOSITE,PSODUZ,0))
SET ZZNM1=+$PIECE($GET(^PS(52.51,ZZNM,0)),"^",2)
+1 SET ZZNAME=$PIECE($GET(^DPT(ZZNM1,0)),"^")
+2 QUIT
VIEW ;
+1 SET PSOEXVW=1
GOTO VW
+2 ;
STAT ;
+1 SET PSX=$PIECE($GET(^PSRX(INRX,"STA")),"^")
+2 SET PSEXSTAT=$SELECT(PSX=0:"ACTIVE",PSX=1:"NON-VERIFIED",PSX=3:"HOLD",PSX=4:"DRUG INTERACTION",PSX=5:"SUSPENDED",PSX=11:"EXPIRED",PSX=12!(PSX=14):"DISCONTINUED",PSX=13:"DELETED",PSX=15:"DISCONTINUED (EDIT)",PSX=16:"PROVIDER HOLD",1:"")
+3 QUIT
RACT ;Set activity log
+1 NEW WW,WRX,WRX,WFILL,WWW,WIR
+2 FOR WW=1:1
SET WRX=$PIECE(PPL,",",WW)
if 'WRX
QUIT
if $GET(WRX)
Begin DoDot:1
+3 IF '$GET(RXPR(WRX))
SET WFILL=0
FOR WWW=0:0
SET WWW=$ORDER(^PSRX(WRX,1,WWW))
if 'WWW
QUIT
SET WFILL=WWW
if WWW>5
SET WFILL=WWW+1
+4 SET WIR=0
FOR WWW=0:0
SET WWW=$ORDER(^PSRX(WRX,"A",WWW))
if 'WWW
QUIT
SET WIR=WWW
+5 SET WIR=WIR+1
SET ^PSRX(WRX,"A",0)="^52.3DA^"_WIR_"^"_WIR
+6 DO NOW^%DTC
SET ^PSRX(WRX,"A",WIR,0)=%_"^W^"_+$GET(DUZ)_"^"_$SELECT($GET(RXPR(WRX)):6,1:$GET(WFILL))_"^"_"Reprint "_$SELECT($GET(RXPR(WRX)):"(PARTIAL) ",1:"")_"(Originally sent to External Interface)"
End DoDot:1
+7 QUIT
