PSORLST ;BIRM/MFR - List of Patients/Prescriptions for Recall Notice ;12/30/09
;;7.0;OUTPATIENT PHARMACY;**348,371**;DEC 1997;Build 12
;
; External reference to ^PSS50 supported by DBIA 4533
; External reference to ^PSS50P7 supported by DBIA 4662
; External reference to ^DPT supported by DBIA 10035
; External reference to ^PSNDF(50.6 supported by DBIA 2079
;
START ; Prompt user for search/selection criteria.
N PSODTRNG,PSONDC,PSOMED,PSOXDED,PSODDRG,PSOOI,PSOGEN,DDRG,EXIT,PSODIV,PSORXDIV,PSODJ
N DIC,PSODEAD,OUTPUT,PSOSDIV,PSOTYPE
;
; - Division/Site selection
D DIVSEL(.PSOSDIV) I $G(PSOSDIV)="^" G EXIT
I $G(PSOSDIV)="ALL" S PSODIV=0 F S PSODIV=$O(^PS(59,PSODIV)) Q:'PSODIV S PSOSDIV(PSODIV)=""
;
; Date range selection
W ! S PSODTRNG=$$DTRNG("T-90","T") I PSODTRNG="^" G START
LKTP ; Type of Drug Lookup
S PSOMED=$$MED() W ! I PSOMED<1 D EXIT W !! G START
I PSOMED=1 D NDC(.PSONDC) I $D(PSONDC)<10 D EXIT G LKTP
I PSOMED=2!(PSOMED=3) D DDRG(.PSODDRG,PSOMED) I ($D(PSODDRG)<10) D EXIT G LKTP
I PSOMED=4 D GENERIC(.PSODDRG) I $D(PSODDRG)<10 D EXIT G LKTP
I PSOMED=5 D ORDITEM(.PSODDRG) I $D(PSODDRG)<10 D EXIT G LKTP
; Exclude Deceased Patients?
W ! S PSOXDED=$$EXCL() I PSOXDED="^" G START
;
D MARGIN
W ! D DEV I $G(EXIT) D EXIT G START
D EXCMSG I $G(DUOUT) D EXIT G START
;
QUE ; Entry point for queued report. Begin processing based on user's selection criteria.
U IO
D PROCESS^PSORLST2
G START
;
EXIT ; Quit.
Q
;
DTRNG(BGN,END) ; Date Range Selection
;Input: (o) BGN - Default Begin Date
; (o) END - Default End Date
N %DT,DTOUT,DUOUT,DTRNG,X,Y
S DTRNG=""
S %DT="AEST",%DT("A")="From Release Date: ",%DT("B")=$G(BGN) K:$G(BGN)="" %DT("B") D ^%DT
I $G(DUOUT)!$G(DTOUT)!($G(Y)=-1) Q "^"
S $P(DTRNG,U)=Y
W ! K %DT
S %DT="AEST",%DT("A")="To Release Date: ",%DT("B")=$G(END),%DT(0)=Y K:$G(END)="" %DT("B") D ^%DT
I $G(DUOUT)!$G(DTOUT)!($G(Y)=-1) Q "^"
S $P(DTRNG,U,2)=Y
Q DTRNG
;
EXCL() ; Exclude Deceased Patients
; Input: (o) EXCLUDE - "Y"es or "N"o
K DIR,X,Y S DIR("A")="Exclude Deceased Patients"
S DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR
Q Y
;
MED() ; Select Medication(s)
; Medication Selection (NDC/Dispense Drug/Generic Drug)
K DIR,Y,X
S DIR(0)="S^1:NDC;2:DISPENSE DRUG AND LOT NUMBER;3:DISPENSE DRUG;4:VA GENERIC NAME;5:ORDERABLE ITEM"
S DIR("A")="Select 1-5 ",DIR("?")="Choose a drug selection method."
D ^DIR
Q Y
;
NDC(NDC) ; Select NDC
K NDC
F Q:Y<1 D
.K DIR,X,Y
.S DIR("A")="NDC"
.S DIR(0)="FO^5:13"
.S DIR("?")="Answer must be from 5 to 20 characters, in correct NDC format ( e.g., 4-4-2, 5-3-2, 5-4-1, 5-4-2, or 6-4-2)"
.D ^DIR
.I Y'="",$TR($TR(Y,"-","")," ","")="" W !,DIR("?") S Y=1 Q
.I Y>0 S NDC($TR($TR(Y,"-","")," ",""))=1
I '$D(NDC) W !!," *** NO NDC SELECTED ***"
Q
;
DDRG(PSODDRG,LOTSEL) ; Select Dispense Drug
K DIC
S DIC=50,DIC(0)="QVAEZ",DIC("A")="Dispense Drug: "
S DIC("S")="I $S($G(^(""I"")):0,1:1)"
F Q:(Y<1)!$G(EXIT) K X,Y D ^DIC I Y>0 S PSODDRG(+Y)=$P(Y,"^",2) I LOTSEL=2 D LOT(+Y,.PSODDRG,Y(0,0))
I '$D(PSODDRG) W !!," *** NO MEDICATION SELECTED ***"
Q
;
LOT(DRGNO,DRGARR,DRGNAM) ; Enter Lot Number(s)
N X,Y,LOT,EXIT,PSOLOTAR
F Q:$G(EXIT) D
.K DIR,Y,X
.S DIR("A")="Lot # ",DIR(0)="FO^2:20"
.D ^DIR S:$G(DUOUT) EXIT=1 W !
.I $L(Y)>1 S PSOLOTAR(Y)="",DRGARR(DRGNO,Y)="" Q
.I Y="",$D(PSOLOTAR)>1 S EXIT=1
.Q:$D(PSOLOTAR)>1
.I '$G(EXIT),Y="" W !?5,"At least one Lot # must be entered" Q
I $G(EXIT),'$D(PSOLOTAR) K DRGARR(DRGNO),PSOLOTAR W !?27,"* No LOT # was entered *" D
.W !?((80-$L(DRGNAM))/2),DRGNAM,!?22,"will not be included on the report",!!
Q
;
GENERIC(PSODDRG) ; Select drug by VA GENERIC (file 50.6)
N GENUM,GENAM,DDRGLI,INACTDT,DDRGLIA
S INACTDT=$$FMADD^XLFDT(DT,-1)
GLOOP ; Prompt loop
S DIC="^PSNDF(50.6,",DIC(0)="QMEAZ",DIC("A")="VA Generic Name: "
F Q:($G(GENUM)<0) K X,Y D ^DIC S GENUM=+Y I GENUM>0 S GENUM=+Y,GENAM=$P(Y,"^",2) D
.K ^TMP($J,"PSORLDN"),^TMP($J,"PSORLGN")
.D AND^PSS50(GENUM,INACTDT,,"PSORLGN")
.S DDRGLI=0 F S DDRGLI=$O(^TMP($J,"PSORLGN",DDRGLI)) Q:'DDRGLI D
..D DATA^PSS50(DDRGLI,,INACTDT,,,"PSORLDN")
..S DDRGLIA(DDRGLI)=$G(^TMP($J,"PSORLDN",DDRGLI,.01)) K ^TMP($J,"PSORLDN",DDRGLI)
.I $D(DDRGLIA)>1 D DDSEL(.DDRGLIA,.PSODDRG)
I '$D(PSODDRG) W !!," *** NO MEDICATION SELECTED ***"
Q
;
ORDITEM(PSODDRG) ; Select drug by ORDERABLE ITEM (file 50.7)
N OINUM,OINAM,OIDRGLI,INACTDT,OINUM,OIDRGLIA
S INACTDT=$$FMADD^XLFDT(DT,-1)
OLOOP ; Prompt loop
S DIC="50.7",DIC(0)="QMEAZ",DIC("A")="Orderable Item: ",DIC("S")="I $S($P($G(^(0)),""^"",4):0,1:1)"
F Q:($G(OINUM)<0) K X,Y D ^DIC S OINUM=+Y I OINUM>0 S OINAM=$P(Y,"^",2) D
.K ^TMP($J,"PSORLDN"),^TMP($J,"PSORLDOI")
.D DRGIEN^PSS50P7(OINUM,INACTDT,"PSORLOI")
.S OIDRGLI=0 F S OIDRGLI=$O(^TMP($J,"PSORLOI",OIDRGLI)) Q:'OIDRGLI D
..D DATA^PSS50(OIDRGLI,,INACTDT,,,"PSORLDN")
..S DDRGLIA(OIDRGLI)=$G(^TMP($J,"PSORLDN",OIDRGLI,.01)) K ^TMP($J,"PSORLDN",OIDRGLI)
.I $D(DDRGLIA)>1 D DDSEL(.DDRGLIA,.PSODDRG)
I '$D(PSODDRG) W !!," *** NO MEDICATION SELECTED ***"
Q
;
DDSEL(DDIN,DDOUT) ; Display selectable dispense drugs (DDIN), prompt for selection, save selected dispense drugs in DDOUT
K DIR
I $D(DDIN)<10 K DDIN Q
W !!?2,"Dispense Drugs"
W !?2,"---------------"
S (II,DD)=0 F II=1:1 S DD=$O(DDIN(DD)) Q:'DD W !?3,II," - ",DDIN(DD)
W ! S II=II-1 S DIR(0)="L^1:"_II D ^DIR W !
S (II,DD)=0 F II=1:1 S DD=$O(DDIN(DD)) Q:'DD I (","_Y_",")[(","_II_",") S DDOUT(DD)=DDIN(DD)
K DDIN
Q
;
DEV ; Prompt user for output device
K %ZIS,IOP,POP,ZTSK,EXIT S PSOION=$I,%ZIS="QM"
D ^%ZIS K %ZIS
I POP S IOP=PSOION D ^%ZIS K IOP,PSOION W !,"Please try later!" S EXIT=1
S X=0 X ^%ZOSF("RM")
K PSOION I $D(IO("Q")) D S EXIT=1 Q
.S ZTDESC="List of Patient for Recall Notice",ZTRTN="QUE^PSORLST"
.F G="PSODTRNG","PSOXDED","PSOMED","PSODIV","PSODJ","PSONDC(","PSODDRG(","PSOSDIV(" S ZTSAVE(G)=""
.K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print!" K ZTSK
Q
;
DIVSEL(ARRAY) ; - Division selection (one, multiple or ALL)
N DIC,DTOUT,DUOUT,QT,Y,X
W !!,"You may select a single or multiple Divisions,"
W !,"or enter ^ALL to select all Divisions.",!
I '$G(DT) N DT S DT=$$NOW^XLFDT()
S DIC("S")="I $S('$D(^PS(59,+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0)"
K ARRAY S DIC="^PS(59,",DIC(0)="QEZAM",DIC("A")="Division: "
F D ^DIC Q:X="" D Q:$G(QT)
.I $$UP^XLFSTR(X)="^ALL" K ARRAY S ARRAY="ALL",QT=1 Q
.I $D(DTOUT)!$D(DUOUT) K ARRAY S ARRAY="^",QT=1 Q
.W " ",$P(Y,"^",2),$S($D(ARRAY(+Y)):" (already selected)",1:"")
.W ! S ARRAY(+Y)="",DIC("A")="ANOTHER ONE: " K DIC("B")
I '$D(ARRAY) S ARRAY="^"
Q
;
EXCMSG ;Display the message about capturing to an Excel file format
K DUOUT
Q:$E($G(IOST))'="C"
W !!?5,"Before continuing, please set up your terminal to capture the"
W !?5,"detailed report data. On some terminals, this can be done by"
W !?5,"clicking on the 'Tools' menu above, then click on 'Capture"
W !?5,"Incoming Data' to save to Desktop."
W !
W !?5," *** THIS REPORT MAY TAKE AWHILE TO RUN ***",!!
N DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
W !
Q
;
MARGIN ; Display message about margin and page length
I $G(PSODWFL) D
. W !!!?8,"** Users unfamiliar with sort templates should review **"
. W !?8,"** sort template documentation before continuing. **"
. K PSODFWL
W !!
W !?8,"** To avoid undesired wrapping of the output data, **"
W !?8,"** please enter '0;512;999' at the 'DEVICE:' prompt. **" ;371 change from 256 to 512.
W !?8,"** You may need to set your Terminal Session Display **" ;371 Add the next two lines.
W !?8,"** Settings to 512 columns. **"
W !
Q
;
PSODED(RXIEN) ;
N PSODED
S PSODED=""
I $G(DFN) S PSODED=$S($G(^DPT(+$P(^PSRX(RXIEN,0),"^",2),.35)):"Y",1:"N")
Q PSODED
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORLST 7966 printed Oct 16, 2024@18:34:39 Page 2
PSORLST ;BIRM/MFR - List of Patients/Prescriptions for Recall Notice ;12/30/09
+1 ;;7.0;OUTPATIENT PHARMACY;**348,371**;DEC 1997;Build 12
+2 ;
+3 ; External reference to ^PSS50 supported by DBIA 4533
+4 ; External reference to ^PSS50P7 supported by DBIA 4662
+5 ; External reference to ^DPT supported by DBIA 10035
+6 ; External reference to ^PSNDF(50.6 supported by DBIA 2079
+7 ;
START ; Prompt user for search/selection criteria.
+1 NEW PSODTRNG,PSONDC,PSOMED,PSOXDED,PSODDRG,PSOOI,PSOGEN,DDRG,EXIT,PSODIV,PSORXDIV,PSODJ
+2 NEW DIC,PSODEAD,OUTPUT,PSOSDIV,PSOTYPE
+3 ;
+4 ; - Division/Site selection
+5 DO DIVSEL(.PSOSDIV)
IF $GET(PSOSDIV)="^"
GOTO EXIT
+6 IF $GET(PSOSDIV)="ALL"
SET PSODIV=0
FOR
SET PSODIV=$ORDER(^PS(59,PSODIV))
if 'PSODIV
QUIT
SET PSOSDIV(PSODIV)=""
+7 ;
+8 ; Date range selection
+9 WRITE !
SET PSODTRNG=$$DTRNG("T-90","T")
IF PSODTRNG="^"
GOTO START
LKTP ; Type of Drug Lookup
+1 SET PSOMED=$$MED()
WRITE !
IF PSOMED<1
DO EXIT
WRITE !!
GOTO START
+2 IF PSOMED=1
DO NDC(.PSONDC)
IF $DATA(PSONDC)<10
DO EXIT
GOTO LKTP
+3 IF PSOMED=2!(PSOMED=3)
DO DDRG(.PSODDRG,PSOMED)
IF ($DATA(PSODDRG)<10)
DO EXIT
GOTO LKTP
+4 IF PSOMED=4
DO GENERIC(.PSODDRG)
IF $DATA(PSODDRG)<10
DO EXIT
GOTO LKTP
+5 IF PSOMED=5
DO ORDITEM(.PSODDRG)
IF $DATA(PSODDRG)<10
DO EXIT
GOTO LKTP
+6 ; Exclude Deceased Patients?
+7 WRITE !
SET PSOXDED=$$EXCL()
IF PSOXDED="^"
GOTO START
+8 ;
+9 DO MARGIN
+10 WRITE !
DO DEV
IF $GET(EXIT)
DO EXIT
GOTO START
+11 DO EXCMSG
IF $GET(DUOUT)
DO EXIT
GOTO START
+12 ;
QUE ; Entry point for queued report. Begin processing based on user's selection criteria.
+1 USE IO
+2 DO PROCESS^PSORLST2
+3 GOTO START
+4 ;
EXIT ; Quit.
+1 QUIT
+2 ;
DTRNG(BGN,END) ; Date Range Selection
+1 ;Input: (o) BGN - Default Begin Date
+2 ; (o) END - Default End Date
+3 NEW %DT,DTOUT,DUOUT,DTRNG,X,Y
+4 SET DTRNG=""
+5 SET %DT="AEST"
SET %DT("A")="From Release Date: "
SET %DT("B")=$GET(BGN)
if $GET(BGN)=""
KILL %DT("B")
DO ^%DT
+6 IF $GET(DUOUT)!$GET(DTOUT)!($GET(Y)=-1)
QUIT "^"
+7 SET $PIECE(DTRNG,U)=Y
+8 WRITE !
KILL %DT
+9 SET %DT="AEST"
SET %DT("A")="To Release Date: "
SET %DT("B")=$GET(END)
SET %DT(0)=Y
if $GET(END)=""
KILL %DT("B")
DO ^%DT
+10 IF $GET(DUOUT)!$GET(DTOUT)!($GET(Y)=-1)
QUIT "^"
+11 SET $PIECE(DTRNG,U,2)=Y
+12 QUIT DTRNG
+13 ;
EXCL() ; Exclude Deceased Patients
+1 ; Input: (o) EXCLUDE - "Y"es or "N"o
+2 KILL DIR,X,Y
SET DIR("A")="Exclude Deceased Patients"
+3 SET DIR(0)="Y"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
+4 QUIT Y
+5 ;
MED() ; Select Medication(s)
+1 ; Medication Selection (NDC/Dispense Drug/Generic Drug)
+2 KILL DIR,Y,X
+3 SET DIR(0)="S^1:NDC;2:DISPENSE DRUG AND LOT NUMBER;3:DISPENSE DRUG;4:VA GENERIC NAME;5:ORDERABLE ITEM"
+4 SET DIR("A")="Select 1-5 "
SET DIR("?")="Choose a drug selection method."
+5 DO ^DIR
+6 QUIT Y
+7 ;
NDC(NDC) ; Select NDC
+1 KILL NDC
+2 FOR
if Y<1
QUIT
Begin DoDot:1
+3 KILL DIR,X,Y
+4 SET DIR("A")="NDC"
+5 SET DIR(0)="FO^5:13"
+6 SET DIR("?")="Answer must be from 5 to 20 characters, in correct NDC format ( e.g., 4-4-2, 5-3-2, 5-4-1, 5-4-2, or 6-4-2)"
+7 DO ^DIR
+8 IF Y'=""
IF $TRANSLATE($TRANSLATE(Y,"-","")," ","")=""
WRITE !,DIR("?")
SET Y=1
QUIT
+9 IF Y>0
SET NDC($TRANSLATE($TRANSLATE(Y,"-","")," ",""))=1
End DoDot:1
+10 IF '$DATA(NDC)
WRITE !!," *** NO NDC SELECTED ***"
+11 QUIT
+12 ;
DDRG(PSODDRG,LOTSEL) ; Select Dispense Drug
+1 KILL DIC
+2 SET DIC=50
SET DIC(0)="QVAEZ"
SET DIC("A")="Dispense Drug: "
+3 SET DIC("S")="I $S($G(^(""I"")):0,1:1)"
+4 FOR
if (Y<1)!$GET(EXIT)
QUIT
KILL X,Y
DO ^DIC
IF Y>0
SET PSODDRG(+Y)=$PIECE(Y,"^",2)
IF LOTSEL=2
DO LOT(+Y,.PSODDRG,Y(0,0))
+5 IF '$DATA(PSODDRG)
WRITE !!," *** NO MEDICATION SELECTED ***"
+6 QUIT
+7 ;
LOT(DRGNO,DRGARR,DRGNAM) ; Enter Lot Number(s)
+1 NEW X,Y,LOT,EXIT,PSOLOTAR
+2 FOR
if $GET(EXIT)
QUIT
Begin DoDot:1
+3 KILL DIR,Y,X
+4 SET DIR("A")="Lot # "
SET DIR(0)="FO^2:20"
+5 DO ^DIR
if $GET(DUOUT)
SET EXIT=1
WRITE !
+6 IF $LENGTH(Y)>1
SET PSOLOTAR(Y)=""
SET DRGARR(DRGNO,Y)=""
QUIT
+7 IF Y=""
IF $DATA(PSOLOTAR)>1
SET EXIT=1
+8 if $DATA(PSOLOTAR)>1
QUIT
+9 IF '$GET(EXIT)
IF Y=""
WRITE !?5,"At least one Lot # must be entered"
QUIT
End DoDot:1
+10 IF $GET(EXIT)
IF '$DATA(PSOLOTAR)
KILL DRGARR(DRGNO),PSOLOTAR
WRITE !?27,"* No LOT # was entered *"
Begin DoDot:1
+11 WRITE !?((80-$LENGTH(DRGNAM))/2),DRGNAM,!?22,"will not be included on the report",!!
End DoDot:1
+12 QUIT
+13 ;
GENERIC(PSODDRG) ; Select drug by VA GENERIC (file 50.6)
+1 NEW GENUM,GENAM,DDRGLI,INACTDT,DDRGLIA
+2 SET INACTDT=$$FMADD^XLFDT(DT,-1)
GLOOP ; Prompt loop
+1 SET DIC="^PSNDF(50.6,"
SET DIC(0)="QMEAZ"
SET DIC("A")="VA Generic Name: "
+2 FOR
if ($GET(GENUM)<0)
QUIT
KILL X,Y
DO ^DIC
SET GENUM=+Y
IF GENUM>0
SET GENUM=+Y
SET GENAM=$PIECE(Y,"^",2)
Begin DoDot:1
+3 KILL ^TMP($JOB,"PSORLDN"),^TMP($JOB,"PSORLGN")
+4 DO AND^PSS50(GENUM,INACTDT,,"PSORLGN")
+5 SET DDRGLI=0
FOR
SET DDRGLI=$ORDER(^TMP($JOB,"PSORLGN",DDRGLI))
if 'DDRGLI
QUIT
Begin DoDot:2
+6 DO DATA^PSS50(DDRGLI,,INACTDT,,,"PSORLDN")
+7 SET DDRGLIA(DDRGLI)=$GET(^TMP($JOB,"PSORLDN",DDRGLI,.01))
KILL ^TMP($JOB,"PSORLDN",DDRGLI)
End DoDot:2
+8 IF $DATA(DDRGLIA)>1
DO DDSEL(.DDRGLIA,.PSODDRG)
End DoDot:1
+9 IF '$DATA(PSODDRG)
WRITE !!," *** NO MEDICATION SELECTED ***"
+10 QUIT
+11 ;
ORDITEM(PSODDRG) ; Select drug by ORDERABLE ITEM (file 50.7)
+1 NEW OINUM,OINAM,OIDRGLI,INACTDT,OINUM,OIDRGLIA
+2 SET INACTDT=$$FMADD^XLFDT(DT,-1)
OLOOP ; Prompt loop
+1 SET DIC="50.7"
SET DIC(0)="QMEAZ"
SET DIC("A")="Orderable Item: "
SET DIC("S")="I $S($P($G(^(0)),""^"",4):0,1:1)"
+2 FOR
if ($GET(OINUM)<0)
QUIT
KILL X,Y
DO ^DIC
SET OINUM=+Y
IF OINUM>0
SET OINAM=$PIECE(Y,"^",2)
Begin DoDot:1
+3 KILL ^TMP($JOB,"PSORLDN"),^TMP($JOB,"PSORLDOI")
+4 DO DRGIEN^PSS50P7(OINUM,INACTDT,"PSORLOI")
+5 SET OIDRGLI=0
FOR
SET OIDRGLI=$ORDER(^TMP($JOB,"PSORLOI",OIDRGLI))
if 'OIDRGLI
QUIT
Begin DoDot:2
+6 DO DATA^PSS50(OIDRGLI,,INACTDT,,,"PSORLDN")
+7 SET DDRGLIA(OIDRGLI)=$GET(^TMP($JOB,"PSORLDN",OIDRGLI,.01))
KILL ^TMP($JOB,"PSORLDN",OIDRGLI)
End DoDot:2
+8 IF $DATA(DDRGLIA)>1
DO DDSEL(.DDRGLIA,.PSODDRG)
End DoDot:1
+9 IF '$DATA(PSODDRG)
WRITE !!," *** NO MEDICATION SELECTED ***"
+10 QUIT
+11 ;
DDSEL(DDIN,DDOUT) ; Display selectable dispense drugs (DDIN), prompt for selection, save selected dispense drugs in DDOUT
+1 KILL DIR
+2 IF $DATA(DDIN)<10
KILL DDIN
QUIT
+3 WRITE !!?2,"Dispense Drugs"
+4 WRITE !?2,"---------------"
+5 SET (II,DD)=0
FOR II=1:1
SET DD=$ORDER(DDIN(DD))
if 'DD
QUIT
WRITE !?3,II," - ",DDIN(DD)
+6 WRITE !
SET II=II-1
SET DIR(0)="L^1:"_II
DO ^DIR
WRITE !
+7 SET (II,DD)=0
FOR II=1:1
SET DD=$ORDER(DDIN(DD))
if 'DD
QUIT
IF (","_Y_",")[(","_II_",")
SET DDOUT(DD)=DDIN(DD)
+8 KILL DDIN
+9 QUIT
+10 ;
DEV ; Prompt user for output device
+1 KILL %ZIS,IOP,POP,ZTSK,EXIT
SET PSOION=$IO
SET %ZIS="QM"
+2 DO ^%ZIS
KILL %ZIS
+3 IF POP
SET IOP=PSOION
DO ^%ZIS
KILL IOP,PSOION
WRITE !,"Please try later!"
SET EXIT=1
+4 SET X=0
XECUTE ^%ZOSF("RM")
+5 KILL PSOION
IF $DATA(IO("Q"))
Begin DoDot:1
+6 SET ZTDESC="List of Patient for Recall Notice"
SET ZTRTN="QUE^PSORLST"
+7 FOR G="PSODTRNG","PSOXDED","PSOMED","PSODIV","PSODJ","PSONDC(","PSODDRG(","PSOSDIV("
SET ZTSAVE(G)=""
+8 KILL IO("Q")
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Report is Queued to print!"
KILL ZTSK
End DoDot:1
SET EXIT=1
QUIT
+9 QUIT
+10 ;
DIVSEL(ARRAY) ; - Division selection (one, multiple or ALL)
+1 NEW DIC,DTOUT,DUOUT,QT,Y,X
+2 WRITE !!,"You may select a single or multiple Divisions,"
+3 WRITE !,"or enter ^ALL to select all Divisions.",!
+4 IF '$GET(DT)
NEW DT
SET DT=$$NOW^XLFDT()
+5 SET DIC("S")="I $S('$D(^PS(59,+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0)"
+6 KILL ARRAY
SET DIC="^PS(59,"
SET DIC(0)="QEZAM"
SET DIC("A")="Division: "
+7 FOR
DO ^DIC
if X=""
QUIT
Begin DoDot:1
+8 IF $$UP^XLFSTR(X)="^ALL"
KILL ARRAY
SET ARRAY="ALL"
SET QT=1
QUIT
+9 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL ARRAY
SET ARRAY="^"
SET QT=1
QUIT
+10 WRITE " ",$PIECE(Y,"^",2),$SELECT($DATA(ARRAY(+Y)):" (already selected)",1:"")
+11 WRITE !
SET ARRAY(+Y)=""
SET DIC("A")="ANOTHER ONE: "
KILL DIC("B")
End DoDot:1
if $GET(QT)
QUIT
+12 IF '$DATA(ARRAY)
SET ARRAY="^"
+13 QUIT
+14 ;
EXCMSG ;Display the message about capturing to an Excel file format
+1 KILL DUOUT
+2 if $EXTRACT($GET(IOST))'="C"
QUIT
+3 WRITE !!?5,"Before continuing, please set up your terminal to capture the"
+4 WRITE !?5,"detailed report data. On some terminals, this can be done by"
+5 WRITE !?5,"clicking on the 'Tools' menu above, then click on 'Capture"
+6 WRITE !?5,"Incoming Data' to save to Desktop."
+7 WRITE !
+8 WRITE !?5," *** THIS REPORT MAY TAKE AWHILE TO RUN ***",!!
+9 NEW DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
KILL DIR
+10 WRITE !
+11 QUIT
+12 ;
MARGIN ; Display message about margin and page length
+1 IF $GET(PSODWFL)
Begin DoDot:1
+2 WRITE !!!?8,"** Users unfamiliar with sort templates should review **"
+3 WRITE !?8,"** sort template documentation before continuing. **"
+4 KILL PSODFWL
End DoDot:1
+5 WRITE !!
+6 WRITE !?8,"** To avoid undesired wrapping of the output data, **"
+7 ;371 change from 256 to 512.
WRITE !?8,"** please enter '0;512;999' at the 'DEVICE:' prompt. **"
+8 ;371 Add the next two lines.
WRITE !?8,"** You may need to set your Terminal Session Display **"
+9 WRITE !?8,"** Settings to 512 columns. **"
+10 WRITE !
+11 QUIT
+12 ;
PSODED(RXIEN) ;
+1 NEW PSODED
+2 SET PSODED=""
+3 IF $GET(DFN)
SET PSODED=$SELECT($GET(^DPT(+$PIECE(^PSRX(RXIEN,0),"^",2),.35)):"Y",1:"N")
+4 QUIT PSODED
