SDRRRECL ;10N20/MAH;Recall Reminder Manual Printing; 09/20/2004
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
;;This routine is called from SDRRLRP
;;If the site has set TYPE OF NOTIFICATION to LETTER this routine
;;will run.
K TYPE
MEN ;SET UP WHAT ARE THEY WOULD LIKE TO PRINT FOR LETTERS
K DIR,Y,DTOUT,DIROUT,DIRUT,DUOUT
S DIR(0)="SO^1:Print Letters by Clinic;2:Print Letters by Provider;3:Print Letters by Team;4:Print a Letter by Patient;5:Print Letters for Nonresponsive Patients"
W ! S DIR("A")="Please select what you are looking for"
D ^DIR G:$D(DUOUT)!($D(DTOUT)!($D(DIRUT))) QUIT S Q=Y
I Q=1 G EN
I Q=2 G EN1
I Q=3 G EN3
I Q=4 G EN4
I Q=5 G EN5
Q
EN ;PRINT BY CLINIC
S DIC="^SC(",DIC(0)="AEQMZ" D ^DIC Q:Y<0 S DIV=+Y G:Y<0 QUIT
I '$D(^SD(403.52,"B",DIV)) W !,?5,"**NO RECALL LETTER ON FILE**" G QUIT
D SELDT G:Y<0 QUIT ;SD*561 quit if no date range entered
S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Letters by Clinic",ZTRTN="DQD^SDRRRECL" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
DQD K ^TMP($J)
U IO S D0=0 F S D0=$O(^SD(403.5,"E",DIV,D0)) Q:D0="" S DTA=$G(^SD(403.5,D0,0)) D:DTA]""
.S TIME=""
.I $P(^SD(403.5,D0,0),"^",9)>30 S TIME=$P(^SD(403.5,D0,0),"^",9) S TIME="**"_TIME_"**"
.S LAB=$S($P($G(^SD(403.5,D0,0)),"^",8)="f":"Lab test(s) have been ordered that require you to FAST",$P(^SD(403.5,D0,0),"^",8)="n":"Lab test(s) have been ordered, which need to be done before an appointment is made",1:"")
.S DFN=+DTA
.Q:$P(DTA,U,6)<SDT!($P(DTA,U,6)>EDT)
.Q:$$TESTPAT^VADPT(DFN)
.D ADD^VADPT,DEM^VADPT
.S STATE=$P(VAPA(5),"^",1),STATE=$$GET1^DIQ(5,STATE_",",1)
.S PN=$P(VADM(1),U)
.I $G(VADM(6),U)'="" Q
.S CHECK=$$BADADR^DGUTL3 I CHECK>0 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D
..S XMY("G.SDRR BAD ADDRESS")="",XMDUZ=.5
..S SDRR(1)="Bad Address- card will not be printed for:"_" "_PN_" "_VA("BID")
..D ^XMD
..K XMY,XMSUB,XMTEXT,XMDUZ
.;ADDED THE DATE INFORMATION
.S $P(^SD(403.5,D0,0),"^",10)=DT
.D PR
D ^%ZISC G QUIT
;;done and tested
QUIT K ADTA,D0,DFN,DIC,DIR,DIRUT,DTA,I,L,PN,POP,Y,DIV,EDT,PR,SDT,FAST,TIME,ACC
K LINE,LETTER,MESSAGE,TEST,DOD,CLINIC,FAIL,TEAM,LAB,SDRR,Q,%DT,%ZIS,CHECK,VA,ZTDESC,ZTIO,ZTRTN,ZTSAVE,STATE Q
D KVAR^VADPT
Q
SELDT S %DT="AEX",%DT("A")="Start with RECALL DATE: " D ^%DT Q:Y<0 S SDT=Y,%DT("A")="End with RECALL DATE: " D ^%DT I Y<SDT W $C(7)," ??" G SELDT
S EDT=Y Q
PR S LETTER=0
W @IOF F L=1:1:11 W !
W !?20,$P(PN,",",2)," ",$P(PN,",")
I $P(VAPA(1),U)'="" W !?20,$P(VAPA(1),U)
I $P(VAPA(2),U)'="" W !?20,$P(VAPA(2),U)
I $P(VAPA(3),U)'="" W !?20,$P(VAPA(3),U)
W !?20,$P(VAPA(4),U),", "_STATE_" ",$P(VAPA(6),U)
I $D(MESSAGE) W !!!!!,?25,MESSAGE
; SD*569 - Adjust the tab starting position
I TIME'="" W !!!!?2,TIME
I LAB'="" W !!!!!,?2,"*"_LAB
W !!!
S:'$D(MESSAGE) LETTER=$O(^SD(403.52,"B",DIV,LETTER))
I LETTER>0 S LINE=0 F S LINE=$O(^SD(403.52,LETTER,1,LINE)) Q:'LINE W !,?2,$P(^SD(403.52,LETTER,1,LINE,0),"^",1)
K MESSAGE
Q
EN1 ;print letters by provider
S DIC="^SD(403.54,",DIC(0)="AEQMZ",DIC("A")="Select Provider: " D ^DIC G:Y<0 QUIT S PR=+Y
D SELDT G:Y<0 QUIT ;SD*5.3*561 quit if no date range entered
S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Letters by Provider",ZTRTN="DQD1^SDRRRECL" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
DQD1 K ^TMP($J)
U IO S D0=0 F S D0=$O(^SD(403.5,"C",PR,D0)) Q:D0="" S (CLINIC,FAIL)=0 S CLINIC=$P($G(^SD(403.5,D0,0)),"^",2) D
.S DTA=$G(^SD(403.5,D0,0))
.I CLINIC="" S FAIL=1 S MESSAGE="***NO CLINIC ON FILE**"
.I CLINIC'="" I '$D(^SD(403.52,"B",CLINIC)) S MESSAGE="***NO CLINIC LETTER ON FILE**" S FAIL=1
.I CLINIC'="",(FAIL=0) S DIV=CLINIC S LETTER=0,LETTER=$O(^SD(403.52,"B",CLINIC,LETTER))
.S TIME=""
.I $P(^SD(403.5,D0,0),"^",9)>30 S TIME=$P(^SD(403.5,D0,0),"^",9) S TIME="**"_TIME_"**"
.S LAB=$S($P($G(^SD(403.5,D0,0)),"^",8)="f":"Lab test(s) have been ordered that require you to FAST",$P(^SD(403.5,D0,0),"^",8)="n":"Lab test(s) have been ordered, which need to be done before an appointment is made",1:"")
.S DFN=+DTA
.Q:$P(DTA,U,6)<SDT!($P(DTA,U,6)>EDT)
.Q:$$TESTPAT^VADPT(DFN)
.D ADD^VADPT,DEM^VADPT
.S STATE=$P(VAPA(5),"^",1),STATE=$$GET1^DIQ(5,STATE_",",1)
.S PN=$P(VADM(1),U)
.I $G(VADM(6),U)'="" Q
.S CHECK=$$BADADR^DGUTL3 I CHECK>0 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D
..S XMY("G.SDRR BAD ADDRESS")="",XMDUZ=.5
..S SDRR(1)="Bad Address- card will not be printed for:"_" "_PN_" "_VA("BID")
..D ^XMD
..K XMY,XMSUB,XMTEXT,XMDUZ
.;ADDED THE DATE INFORMATION
.S $P(^SD(403.5,D0,0),"^",10)=DT
.D PR
D ^%ZISC G QUIT
EN3 ;PRINT LETTER FOR A TEAM
W ! S DIC="^SD(403.55,",DIC(0)="AEQMZ",DIC("A")="Select Clinic Recall Team: " D ^DIC S TEAM=+Y K DIC G:Y<0 QUIT
D SELDT G:Y<0 QUIT ;SD*561 quit if no date range entered
S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Letters for a Team",ZTRTN="DQD4^SDRRRECL" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
DQD4 S PR=0 F S PR=$O(^SD(403.54,"C",TEAM,PR)) Q:'PR S D0=0 D
.F S D0=$O(^SD(403.5,"C",PR,D0)) Q:D0="" S (CLINIC,FAIL)=0 S CLINIC=$P($G(^SD(403.5,D0,0)),"^",2) D
..S DTA=$G(^SD(403.5,D0,0))
..I CLINIC="" S FAIL=1 S MESSAGE="***NO CLINIC ON FILE**"
..I CLINIC'="" I '$D(^SD(403.52,"B",CLINIC)) S MESSAGE="***NO CLINIC LETTER ON FILE**" S FAIL=1
..I CLINIC'="",(FAIL=0) S DIV=CLINIC S LETTER=0,LETTER=$O(^SD(403.52,"B",CLINIC,LETTER))
..S TIME=""
..I $P(^SD(403.5,D0,0),"^",9)>30 S TIME=$P(^SD(403.5,D0,0),"^",9) S TIME="**"_TIME_"**"
..S LAB=$S($P($G(^SD(403.5,D0,0)),"^",8)="f":"Lab test(s) have been ordered that require you to FAST",$P(^SD(403.5,D0,0),"^",8)="n":"Lab test(s) have been ordered, which need to be done before an appointment is made",1:"")
..S DFN=+DTA
..Q:$P(DTA,U,6)<SDT!($P(DTA,U,6)>EDT) ;SD*561 check selected date range
..Q:$$TESTPAT^VADPT(DFN)
..D ADD^VADPT,DEM^VADPT
..S STATE=$P(VAPA(5),"^",1),STATE=$$GET1^DIQ(5,STATE_",",1)
..S PN=$P(VADM(1),U)
..I $G(VADM(6),U)'="" Q
..S CHECK=$$BADADR^DGUTL3 I CHECK>0 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D
...S XMY("G.SDRR BAD ADDRESS")="",XMDUZ=.5
...S SDRR(1)="Bad Address- card will not be printed for:"_" "_PN_" "_VA("BID")
...D ^XMD
...K XMY,XMSUB,XMTEXT,XMDUZ
..;ADDED THE DATE INFORMATION
..S $P(^SD(403.5,D0,0),"^",10)=DT
..D PR
D ^%ZISC G QUIT
;done and tested
EN4 ;PRINT LETTER FOR ONE PATIENT
W ! S DIC="^SD(403.5,",DIC(0)="AEQMZ",DIC("A")="Select Patient: " D ^DIC S D0=+Y K DIC G:Y<0 QUIT
S DIC="^SC(",DIC(0)="AEQMZ" D ^DIC Q:Y<0 S DIV=+Y K DIC G:Y<0 QUIT
I '$D(^SD(403.52,"B",DIV)) W !,?5,"**NO RECALL LETTER ON FILE**" G QUIT
I '$D(^SD(403.5,"E",DIV,D0)) W *7,!!,?5,"**This patient does not have a recall reminder for the selected clinic**",!! G QUIT
S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Letters for a Patient",ZTRTN="DQD3^SDRRRECL" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
DQD3 K ^TMP($J)
S DTA=$G(^SD(403.5,D0,0)) D:DTA]""
.; SD*569 - Quit if patient's clinic does not match the selected hospital location.
.I $P(DTA,"^",2)'=DIV Q
.S TIME=""
.I $P(^SD(403.5,D0,0),"^",9)>30 S TIME=$P(^SD(403.5,D0,0),"^",9) S TIME="**"_TIME_"**"
.S LAB=$S($P($G(^SD(403.5,D0,0)),"^",8)="f":"Lab test(s) have been ordered that require you to FAST",$P(^SD(403.5,D0,0),"^",8)="n":"Lab test(s) have been ordered, which need to be done before an appointment is made",1:"")
.S DFN=+DTA
.Q:$$TESTPAT^VADPT(DFN)
.D ADD^VADPT,DEM^VADPT
.S STATE=$P(VAPA(5),"^",1),STATE=$$GET1^DIQ(5,STATE_",",1)
.S PN=$P(VADM(1),U)
.I $G(VADM(6),U)'="" Q
.S CHECK=$$BADADR^DGUTL3 I CHECK>0 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D
..S XMY("G.SDRR BAD ADDRESS")="",XMDUZ=.5
..S SDRR(1)="Bad Address- card will not be printed for:"_" "_PN_" "_VA("BID")
..D ^XMD
..K XMY,XMSUB,XMTEXT,XMDUZ
.;ADDED THE DATE INFORMATION
.S $P(^SD(403.5,D0,0),"^",10)=DT
.D PR
D ^%ZISC G QUIT
EN5 ;Print LETTERS for Nonresponsive
S TEAM=""
S DIC="^SD(403.55,",DIC(0)="AEQMZ",DIC("A")="Select Clinic Recall Team: " D ^DIC S TEAM=+Y K DIC G:TEAM<0 QUIT
S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Letters for Nonresponsive",ZTRTN="DQD5^SDRRRECL" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
DQD5 N CHKDATE
;SD*5.3*561 remove extraneous write command following $O on next line
S PR=0,CHKDATE=5 F S PR=$O(^SD(403.54,"C",TEAM,PR)) Q:'PR D
.S D0=0 F S D0=$O(^SD(403.5,"C",PR,D0)) Q:'D0 S (CLINIC,FAIL)=0 S CLINIC=$P($G(^SD(403.5,D0,0)),"^",2) D
..I $P($G(^SD(403.5,D0,0)),"^",10)="" QUIT
..; SD*569 - Prevent from printing more than ONE second letter.
..I $P($G(^SD(403.5,D0,0)),"^",13)'="" QUIT
..S RDATE=$P($G(^SD(403.5,D0,0)),"^",6) S CHECK=$$FMDIFF^XLFDT(RDATE,DT) I CHECK>CHKDATE K RDATE QUIT
..S DTA=$G(^SD(403.5,D0,0))
..I CLINIC="" S FAIL=1 S MESSAGE="***NO CLINIC ON FILE**"
..I CLINIC'="" I '$D(^SD(403.52,"B",CLINIC)) S MESSAGE="***NO CLINIC LETTER ON FILE**" S FAIL=1
..I CLINIC'="",(FAIL=0) S DIV=CLINIC S LETTER=0,LETTER=$O(^SD(403.52,"B",CLINIC,LETTER))
..S TIME=""
..I $P(^SD(403.5,D0,0),"^",9)>30 S TIME=$P(^SD(403.5,D0,0),"^",9) S TIME="**"_TIME_"**"
..S LAB=$S($P($G(^SD(403.5,D0,0)),"^",8)="f":"Lab test(s) have been ordered that require you to FAST",$P(^SD(403.5,D0,0),"^",8)="n":"Lab test(s) have been ordered, which need to be done before an appointment is made",1:"")
..S DFN=+DTA
..Q:$$TESTPAT^VADPT(DFN)
..D ADD^VADPT,DEM^VADPT
..S STATE=$P(VAPA(5),"^",1),STATE=$$GET1^DIQ(5,STATE_",",1)
..S PN=$P(VADM(1),U)
..I $G(VADM(6),U)'="" Q
..S CHECK=$$BADADR^DGUTL3 I CHECK>0 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D
...S XMY("G.SDRR BAD ADDRESS")="",XMDUZ=.5
...S SDRR(1)="Bad Address- card will not be printed for:"_" "_PN_" "_VA("BID")
...D ^XMD
...K XMY,XMSUB,XMTEXT,XMDUZ
..;ADDED THE DATE INFORMATION
..S $P(^SD(403.5,D0,0),"^",13)=DT
..D PR
D ^%ZISC G QUIT
Q
SDRRRECL ;10N20/MAH;Recall Reminder Manual Printing; 09/20/2004
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
+2 ;;This routine is called from SDRRLRP
+3 ;;If the site has set TYPE OF NOTIFICATION to LETTER this routine
+4 ;;will run.
+5 KILL TYPE
MEN ;SET UP WHAT ARE THEY WOULD LIKE TO PRINT FOR LETTERS
+1 KILL DIR,Y,DTOUT,DIROUT,DIRUT,DUOUT
+2 SET DIR(0)="SO^1:Print Letters by Clinic;2:Print Letters by Provider;3:Print Letters by Team;4:Print a Letter by Patient;5:Print Letters for Nonresponsive Patients"
+3 WRITE !
SET DIR("A")="Please select what you are looking for"
+4 DO ^DIR
IF $DATA(DUOUT)!($DATA(DTOUT)!($DATA(DIRUT)))
GOTO QUIT
SET Q=Y
+5 IF Q=1
GOTO EN
+6 IF Q=2
GOTO EN1
+7 IF Q=3
GOTO EN3
+8 IF Q=4
GOTO EN4
+9 IF Q=5
GOTO EN5
+10 QUIT
EN ;PRINT BY CLINIC
+1 SET DIC="^SC("
SET DIC(0)="AEQMZ"
DO ^DIC
IF Y<0
QUIT
SET DIV=+Y
IF Y<0
GOTO QUIT
+2 IF '$DATA(^SD(403.52,"B",DIV))
WRITE !,?5,"**NO RECALL LETTER ON FILE**"
GOTO QUIT
+3 ;SD*561 quit if no date range entered
DO SELDT
IF Y<0
GOTO QUIT
+4 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO QUIT
IF $DATA(IO("Q"))
SET ZTDESC="Print Recall Letters by Clinic"
SET ZTRTN="DQD^SDRRRECL"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
GOTO QUIT
DQD KILL ^TMP($JOB)
+1 USE IO
SET D0=0
FOR
SET D0=$ORDER(^SD(403.5,"E",DIV,D0))
IF D0=""
QUIT
SET DTA=$GET(^SD(403.5,D0,0))
IF DTA]""
Begin DoDot:1
+2 SET TIME=""
+3 IF $PIECE(^SD(403.5,D0,0),"^",9)>30
SET TIME=$PIECE(^SD(403.5,D0,0),"^",9)
SET TIME="**"_TIME_"**"
+4 SET LAB=$SELECT($PIECE($GET(^SD(403.5,D0,0)),"^",8)="f":"Lab test(s) have been ordered that require you to FAST",$PIECE(^SD(403.5,D0,0),"^",8)="n":"Lab test(s) have been ordered, which need to be done before an appointment is made",
1:"")
+5 SET DFN=+DTA
+6 IF $PIECE(DTA,U,6)<SDT!($PIECE(DTA,U,6)>EDT)
QUIT
+7 IF $$TESTPAT^VADPT(DFN)
QUIT
+8 DO ADD^VADPT
DO DEM^VADPT
+9 SET STATE=$PIECE(VAPA(5),"^",1)
SET STATE=$$GET1^DIQ(5,STATE_",",1)
+10 SET PN=$PIECE(VADM(1),U)
+11 IF $GET(VADM(6),U)'=""
QUIT
+12 SET CHECK=$$BADADR^DGUTL3
IF CHECK>0
SET XMSUB="Bad Address for Recall Reminder Patient"
SET XMTEXT="SDRR("
Begin DoDot:2
+13 SET XMY("G.SDRR BAD ADDRESS")=""
SET XMDUZ=.5
+14 SET SDRR(1)="Bad Address- card will not be printed for:"_" "_PN_" "_VA("BID")
+15 DO ^XMD
+16 KILL XMY,XMSUB,XMTEXT,XMDUZ
End DoDot:2
+17 ;ADDED THE DATE INFORMATION
+18 SET $PIECE(^SD(403.5,D0,0),"^",10)=DT
+19 DO PR
End DoDot:1
+20 DO ^%ZISC
GOTO QUIT
+21 ;;done and tested
QUIT KILL ADTA,D0,DFN,DIC,DIR,DIRUT,DTA,I,L,PN,POP,Y,DIV,EDT,PR,SDT,FAST,TIME,ACC
+1 KILL LINE,LETTER,MESSAGE,TEST,DOD,CLINIC,FAIL,TEAM,LAB,SDRR,Q,%DT,%ZIS,CHECK,VA,ZTDESC,ZTIO,ZTRTN,ZTSAVE,STATE
QUIT
+2 DO KVAR^VADPT
+3 QUIT
SELDT SET %DT="AEX"
SET %DT("A")="Start with RECALL DATE: "
DO ^%DT
IF Y<0
QUIT
SET SDT=Y
SET %DT("A")="End with RECALL DATE: "
DO ^%DT
IF Y<SDT
WRITE $CHAR(7)," ??"
GOTO SELDT
+1 SET EDT=Y
QUIT
PR SET LETTER=0
+1 WRITE @IOF
FOR L=1:1:11
WRITE !
+2 WRITE !?20,$PIECE(PN,",",2)," ",$PIECE(PN,",")
+3 IF $PIECE(VAPA(1),U)'=""
WRITE !?20,$PIECE(VAPA(1),U)
+4 IF $PIECE(VAPA(2),U)'=""
WRITE !?20,$PIECE(VAPA(2),U)
+5 IF $PIECE(VAPA(3),U)'=""
WRITE !?20,$PIECE(VAPA(3),U)
+6 WRITE !?20,$PIECE(VAPA(4),U),", "_STATE_" ",$PIECE(VAPA(6),U)
+7 IF $DATA(MESSAGE)
WRITE !!!!!,?25,MESSAGE
+8 ; SD*569 - Adjust the tab starting position
+9 IF TIME'=""
WRITE !!!!?2,TIME
+10 IF LAB'=""
WRITE !!!!!,?2,"*"_LAB
+11 WRITE !!!
+12 IF '$DATA(MESSAGE)
SET LETTER=$ORDER(^SD(403.52,"B",DIV,LETTER))
+13 IF LETTER>0
SET LINE=0
FOR
SET LINE=$ORDER(^SD(403.52,LETTER,1,LINE))
IF 'LINE
QUIT
WRITE !,?2,$PIECE(^SD(403.52,LETTER,1,LINE,0),"^",1)
+14 KILL MESSAGE
+15 QUIT
EN1 ;print letters by provider
+1 SET DIC="^SD(403.54,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Provider: "
DO ^DIC
IF Y<0
GOTO QUIT
SET PR=+Y
+2 ;SD*5.3*561 quit if no date range entered
DO SELDT
IF Y<0
GOTO QUIT
+3 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO QUIT
IF $DATA(IO("Q"))
SET ZTDESC="Print Recall Letters by Provider"
SET ZTRTN="DQD1^SDRRRECL"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
GOTO QUIT
DQD1 KILL ^TMP($JOB)
+1 USE IO
SET D0=0
FOR
SET D0=$ORDER(^SD(403.5,"C",PR,D0))
IF D0=""
QUIT
SET (CLINIC,FAIL)=0
SET CLINIC=$PIECE($GET(^SD(403.5,D0,0)),"^",2)
Begin DoDot:1
+2 SET DTA=$GET(^SD(403.5,D0,0))
+3 IF CLINIC=""
SET FAIL=1
SET MESSAGE="***NO CLINIC ON FILE**"
+4 IF CLINIC'=""
IF '$DATA(^SD(403.52,"B",CLINIC))
SET MESSAGE="***NO CLINIC LETTER ON FILE**"
SET FAIL=1
+5 IF CLINIC'=""
IF (FAIL=0)
SET DIV=CLINIC
SET LETTER=0
SET LETTER=$ORDER(^SD(403.52,"B",CLINIC,LETTER))
+6 SET TIME=""
+7 IF $PIECE(^SD(403.5,D0,0),"^",9)>30
SET TIME=$PIECE(^SD(403.5,D0,0),"^",9)
SET TIME="**"_TIME_"**"
+8 SET LAB=$SELECT($PIECE($GET(^SD(403.5,D0,0)),"^",8)="f":"Lab test(s) have been ordered that require you to FAST",$PIECE(^SD(403.5,D0,0),"^",8)="n":"Lab test(s) have been ordered, which need to be done before an appointment is made",1:""
)
+9 SET DFN=+DTA
+10 IF $PIECE(DTA,U,6)<SDT!($PIECE(DTA,U,6)>EDT)
QUIT
+11 IF $$TESTPAT^VADPT(DFN)
QUIT
+12 DO ADD^VADPT
DO DEM^VADPT
+13 SET STATE=$PIECE(VAPA(5),"^",1)
SET STATE=$$GET1^DIQ(5,STATE_",",1)
+14 SET PN=$PIECE(VADM(1),U)
+15 IF $GET(VADM(6),U)'=""
QUIT
+16 SET CHECK=$$BADADR^DGUTL3
IF CHECK>0
SET XMSUB="Bad Address for Recall Reminder Patient"
SET XMTEXT="SDRR("
Begin DoDot:2
+17 SET XMY("G.SDRR BAD ADDRESS")=""
SET XMDUZ=.5
+18 SET SDRR(1)="Bad Address- card will not be printed for:"_" "_PN_" "_VA("BID")
+19 DO ^XMD
+20 KILL XMY,XMSUB,XMTEXT,XMDUZ
End DoDot:2
+21 ;ADDED THE DATE INFORMATION
+22 SET $PIECE(^SD(403.5,D0,0),"^",10)=DT
+23 DO PR
End DoDot:1
+24 DO ^%ZISC
GOTO QUIT
EN3 ;PRINT LETTER FOR A TEAM
+1 WRITE !
SET DIC="^SD(403.55,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Clinic Recall Team: "
DO ^DIC
SET TEAM=+Y
KILL DIC
IF Y<0
GOTO QUIT
+2 ;SD*561 quit if no date range entered
DO SELDT
IF Y<0
GOTO QUIT
+3 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO QUIT
IF $DATA(IO("Q"))
SET ZTDESC="Print Recall Letters for a Team"
SET ZTRTN="DQD4^SDRRRECL"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
GOTO QUIT
DQD4 SET PR=0
FOR
SET PR=$ORDER(^SD(403.54,"C",TEAM,PR))
IF 'PR
QUIT
SET D0=0
Begin DoDot:1
+1 FOR
SET D0=$ORDER(^SD(403.5,"C",PR,D0))
IF D0=""
QUIT
SET (CLINIC,FAIL)=0
SET CLINIC=$PIECE($GET(^SD(403.5,D0,0)),"^",2)
Begin DoDot:2
+2 SET DTA=$GET(^SD(403.5,D0,0))
+3 IF CLINIC=""
SET FAIL=1
SET MESSAGE="***NO CLINIC ON FILE**"
+4 IF CLINIC'=""
IF '$DATA(^SD(403.52,"B",CLINIC))
SET MESSAGE="***NO CLINIC LETTER ON FILE**"
SET FAIL=1
+5 IF CLINIC'=""
IF (FAIL=0)
SET DIV=CLINIC
SET LETTER=0
SET LETTER=$ORDER(^SD(403.52,"B",CLINIC,LETTER))
+6 SET TIME=""
+7 IF $PIECE(^SD(403.5,D0,0),"^",9)>30
SET TIME=$PIECE(^SD(403.5,D0,0),"^",9)
SET TIME="**"_TIME_"**"
+8 SET LAB=$SELECT($PIECE($GET(^SD(403.5,D0,0)),"^",8)="f":"Lab test(s) have been ordered that require you to FAST",$PIECE(^SD(403.5,D0,0),"^",8)="n":"Lab test(s) have been ordered, which need to be done before an appointment is ma
de",1:"")
+9 SET DFN=+DTA
+10 ;SD*561 check selected date range
IF $PIECE(DTA,U,6)<SDT!($PIECE(DTA,U,6)>EDT)
QUIT
+11 IF $$TESTPAT^VADPT(DFN)
QUIT
+12 DO ADD^VADPT
DO DEM^VADPT
+13 SET STATE=$PIECE(VAPA(5),"^",1)
SET STATE=$$GET1^DIQ(5,STATE_",",1)
+14 SET PN=$PIECE(VADM(1),U)
+15 IF $GET(VADM(6),U)'=""
QUIT
+16 SET CHECK=$$BADADR^DGUTL3
IF CHECK>0
SET XMSUB="Bad Address for Recall Reminder Patient"
SET XMTEXT="SDRR("
Begin DoDot:3
+17 SET XMY("G.SDRR BAD ADDRESS")=""
SET XMDUZ=.5
+18 SET SDRR(1)="Bad Address- card will not be printed for:"_" "_PN_" "_VA("BID")
+19 DO ^XMD
+20 KILL XMY,XMSUB,XMTEXT,XMDUZ
End DoDot:3
+21 ;ADDED THE DATE INFORMATION
+22 SET $PIECE(^SD(403.5,D0,0),"^",10)=DT
+23 DO PR
End DoDot:2
End DoDot:1
+24 DO ^%ZISC
GOTO QUIT
+25 ;done and tested
EN4 ;PRINT LETTER FOR ONE PATIENT
+1 WRITE !
SET DIC="^SD(403.5,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Patient: "
DO ^DIC
SET D0=+Y
KILL DIC
IF Y<0
GOTO QUIT
+2 SET DIC="^SC("
SET DIC(0)="AEQMZ"
DO ^DIC
IF Y<0
QUIT
SET DIV=+Y
KILL DIC
IF Y<0
GOTO QUIT
+3 IF '$DATA(^SD(403.52,"B",DIV))
WRITE !,?5,"**NO RECALL LETTER ON FILE**"
GOTO QUIT
+4 IF '$DATA(^SD(403.5,"E",DIV,D0))
WRITE *7,!!,?5,"**This patient does not have a recall reminder for the selected clinic**",!!
GOTO QUIT
+5 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO QUIT
IF $DATA(IO("Q"))
SET ZTDESC="Print Recall Letters for a Patient"
SET ZTRTN="DQD3^SDRRRECL"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
GOTO QUIT
DQD3 KILL ^TMP($JOB)
+1 SET DTA=$GET(^SD(403.5,D0,0))
IF DTA]""
Begin DoDot:1
+2 ; SD*569 - Quit if patient's clinic does not match the selected hospital location.
+3 IF $PIECE(DTA,"^",2)'=DIV
QUIT
+4 SET TIME=""
+5 IF $PIECE(^SD(403.5,D0,0),"^",9)>30
SET TIME=$PIECE(^SD(403.5,D0,0),"^",9)
SET TIME="**"_TIME_"**"
+6 SET LAB=$SELECT($PIECE($GET(^SD(403.5,D0,0)),"^",8)="f":"Lab test(s) have been ordered that require you to FAST",$PIECE(^SD(403.5,D0,0),"^",8)="n":"Lab test(s) have been ordered, which need to be done before an appointment is made",1:""
)
+7 SET DFN=+DTA
+8 IF $$TESTPAT^VADPT(DFN)
QUIT
+9 DO ADD^VADPT
DO DEM^VADPT
+10 SET STATE=$PIECE(VAPA(5),"^",1)
SET STATE=$$GET1^DIQ(5,STATE_",",1)
+11 SET PN=$PIECE(VADM(1),U)
+12 IF $GET(VADM(6),U)'=""
QUIT
+13 SET CHECK=$$BADADR^DGUTL3
IF CHECK>0
SET XMSUB="Bad Address for Recall Reminder Patient"
SET XMTEXT="SDRR("
Begin DoDot:2
+14 SET XMY("G.SDRR BAD ADDRESS")=""
SET XMDUZ=.5
+15 SET SDRR(1)="Bad Address- card will not be printed for:"_" "_PN_" "_VA("BID")
+16 DO ^XMD
+17 KILL XMY,XMSUB,XMTEXT,XMDUZ
End DoDot:2
+18 ;ADDED THE DATE INFORMATION
+19 SET $PIECE(^SD(403.5,D0,0),"^",10)=DT
+20 DO PR
End DoDot:1
+21 DO ^%ZISC
GOTO QUIT
EN5 ;Print LETTERS for Nonresponsive
+1 SET TEAM=""
+2 SET DIC="^SD(403.55,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Clinic Recall Team: "
DO ^DIC
SET TEAM=+Y
KILL DIC
IF TEAM<0
GOTO QUIT
+3 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO QUIT
IF $DATA(IO("Q"))
SET ZTDESC="Print Recall Letters for Nonresponsive"
SET ZTRTN="DQD5^SDRRRECL"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
GOTO QUIT
DQD5 NEW CHKDATE
+1 ;SD*5.3*561 remove extraneous write command following $O on next line
+2 SET PR=0
SET CHKDATE=5
FOR
SET PR=$ORDER(^SD(403.54,"C",TEAM,PR))
IF 'PR
QUIT
Begin DoDot:1
+3 SET D0=0
FOR
SET D0=$ORDER(^SD(403.5,"C",PR,D0))
IF 'D0
QUIT
SET (CLINIC,FAIL)=0
SET CLINIC=$PIECE($GET(^SD(403.5,D0,0)),"^",2)
Begin DoDot:2
+4 IF $PIECE($GET(^SD(403.5,D0,0)),"^",10)=""
QUIT
+5 ; SD*569 - Prevent from printing more than ONE second letter.
+6 IF $PIECE($GET(^SD(403.5,D0,0)),"^",13)'=""
QUIT
+7 SET RDATE=$PIECE($GET(^SD(403.5,D0,0)),"^",6)
SET CHECK=$$FMDIFF^XLFDT(RDATE,DT)
IF CHECK>CHKDATE
KILL RDATE
QUIT
+8 SET DTA=$GET(^SD(403.5,D0,0))
+9 IF CLINIC=""
SET FAIL=1
SET MESSAGE="***NO CLINIC ON FILE**"
+10 IF CLINIC'=""
IF '$DATA(^SD(403.52,"B",CLINIC))
SET MESSAGE="***NO CLINIC LETTER ON FILE**"
SET FAIL=1
+11 IF CLINIC'=""
IF (FAIL=0)
SET DIV=CLINIC
SET LETTER=0
SET LETTER=$ORDER(^SD(403.52,"B",CLINIC,LETTER))
+12 SET TIME=""
+13 IF $PIECE(^SD(403.5,D0,0),"^",9)>30
SET TIME=$PIECE(^SD(403.5,D0,0),"^",9)
SET TIME="**"_TIME_"**"
+14 SET LAB=$SELECT($PIECE($GET(^SD(403.5,D0,0)),"^",8)="f":"Lab test(s) have been ordered that require you to FAST",$PIECE(^SD(403.5,D0,0),"^",8)="n":"Lab test(s) have been ordered, which need to be done before an appointment is ma
de",1:"")
+15 SET DFN=+DTA
+16 IF $$TESTPAT^VADPT(DFN)
QUIT
+17 DO ADD^VADPT
DO DEM^VADPT
+18 SET STATE=$PIECE(VAPA(5),"^",1)
SET STATE=$$GET1^DIQ(5,STATE_",",1)
+19 SET PN=$PIECE(VADM(1),U)
+20 IF $GET(VADM(6),U)'=""
QUIT
+21 SET CHECK=$$BADADR^DGUTL3
IF CHECK>0
SET XMSUB="Bad Address for Recall Reminder Patient"
SET XMTEXT="SDRR("
Begin DoDot:3
+22 SET XMY("G.SDRR BAD ADDRESS")=""
SET XMDUZ=.5
+23 SET SDRR(1)="Bad Address- card will not be printed for:"_" "_PN_" "_VA("BID")
+24 DO ^XMD
+25 KILL XMY,XMSUB,XMTEXT,XMDUZ
End DoDot:3
+26 ;ADDED THE DATE INFORMATION
+27 SET $PIECE(^SD(403.5,D0,0),"^",13)=DT
+28 DO PR
End DoDot:2
End DoDot:1
+29 DO ^%ZISC
GOTO QUIT
+30 QUIT
