SDRRRECP ;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 CARDS this routine
;;will run.
K TYPE
MEN ;SET UP WHAT ARE THEY WOULD LIKE TO PRINT FOR CARDS
K DIR,Y,DTOUT,DIROUT,DIRUT,DUOUT
S DIR(0)="SO^1:Print Cards by Division;2:Print Cards by Clinic;3:Print Cards by Provider;4:Print Cards by Team;5:Print a Card by Patient;6:Print Cards 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 EN3
I Q=2 G EN
I Q=3 G EN2
I Q=4 G EN1
I Q=5 G EN4
I Q=6 G EN5
Q
;ALLK Q,Y,DIR
EN3 ;PRINT BY DIVISION
S DIC="^DG(40.8,",DIC(0)="AEQMZ" D ^DIC G:Y<0 QUIT S DIV=+Y D SELDT G:Y<0 QUIT
S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDSC="Print Recall Cards by Division",ZTRTN="DQD1^SDRRRECP" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
DQD1 K ^TMP($J)
S PR=0 F S PR=$O(^SD(403.5,"C",PR)) Q:PR="" I $P($G(^SD(403.54,PR,0)),"^",3)=DIV S D0=0 F S D0=$O(^SD(403.5,"C",PR,D0)) Q:D0="" S DTA=$G(^SD(403.5,D0,0)) D:DTA]""
.S TIME=""
.I $P(^SD(403.5,D0,0),"^",9)["60" S TIME=$P(^SD(403.5,D0,0),"^",9) S TIME="**"_TIME_"**"
.S LAB=$S($P($G(^SD(403.5,D0,0)),"^",8)="f":"**FL",$P(^SD(403.5,D0,0),"^",8)="n":"**NFL",1:"")
.S DFN=+DTA
.Q:$$TESTPAT^VADPT(DFN)
.D ADD^VADPT,DEM^VADPT
.S PN=$P(VADM(1),U)
.S STATE=$P(VAPA(5),"^",1),STATE=$$GET1^DIQ(5,STATE_",",1)
.I $G(VADM(6),U)'="" Q
.Q:$P(DTA,"^",6)<SDT!($P(DTA,"^",6)>EDT)
.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
EN ;PRINT BY CLINIC
S DIC="^SC(",DIC(0)="AEQMZ" D ^DIC Q:Y<0 S DIV=+Y D SELDT G:Y<0 QUIT
S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Cards by Clinic",ZTRTN="DQD^SDRRRECP" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
DQD K ^TMP($J)
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)["60" S TIME=$P(^SD(403.5,D0,0),"^",9) S TIME="**"_TIME_"**"
.S LAB=$S($P($G(^SD(403.5,D0,0)),"^",8)="f":"**FL",$P(^SD(403.5,D0,0),"^",8)="n":"**NFL",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
.Q:$P(DTA,"^",6)<SDT!($P(DTA,"^",6)>EDT)
.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
QUIT K ADTA,D0,DFN,DIC,DIR,DIRUT,DTA,I,L,PN,POP,Y,DIV,EDT,PR,SDT,TIME,LAB,Y,STATE
K DATE,DOD,X,Q,%DT,%ZIS,SDRR,VA,CHECK,ZTDESC,ZTDSC,ZTEAM,ZTIO,ZTRTN,ZTSAVE
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 W @IOF F L=1:1:7 W !
W !?20,$P($P(PN,",",2)," ",1)_" "_$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 TIME'="" W !!?45,TIME
I LAB'="" W !!?45,LAB
Q
EN1 ;PRINT BY TEAM
S DIC="^SD(403.55,",DIC(0)="AEQMZ",DIC("A")="Select Clinic Team: " D ^DIC Q:Y<0 S ZTEAM=+Y D SELDT G:Y<0 QUIT
S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Cards by Team",ZTRTN="DQT^SDRRRECP" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
DQT K ^TMP($J)
S PR=0 F S PR=$O(^SD(403.5,"C",PR)) Q:PR="" I $P($G(^SD(403.54,PR,0)),U,2)=+ZTEAM S D0=0 F S D0=$O(^SD(403.5,"C",PR,D0)) Q:D0="" S DTA=$G(^SD(403.5,D0,0)) D:DTA]""
.S TIME=""
.I $P(^SD(403.5,D0,0),"^",9)["60" S TIME=$P(^SD(403.5,D0,0),"^",9) S TIME="**"_TIME_"**"
.S LAB=$S($P($G(^SD(403.5,D0,0)),"^",8)="f":"**FL",$P(^SD(403.5,D0,0),"^",8)="n":"**NFL",1:"")
.S DFN=+DTA
.Q:$$TESTPAT^VADPT(DFN)
.D ADD^VADPT,DEM^VADPT
.S PN=$P(VADM(1),U)
.S STATE=$P(VAPA(5),"^",1),STATE=$$GET1^DIQ(5,STATE_",",1)
.I $G(VADM(6),U)'="" Q
.Q:$P(DTA,"^",6)<SDT!($P(DTA,"^",6)>EDT)
.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
..D ^%ZISC G QUIT
.;ADDED THE DATE INFORMATION
.S $P(^SD(403.5,D0,0),"^",10)=DT
.D PR
D ^%ZISC G QUIT
EN2 ;PRINT BY PROV
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
S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Cards by Prov",ZTRTN="DQP^SDRRRECP" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
DQP K ^TMP($J)
S D0=0 F S D0=$O(^SD(403.5,"C",PR,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":"**FL",$P(^SD(403.5,D0,0),"^",8)="n":"**NFL",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
.Q:$P(DTA,"^",6)<SDT!($P(DTA,"^",6)>EDT)
.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
EN4 ;PRINT BY Patient
W ! S DIC="^SD(403.5,",DIC(0)="AEQMZ",DIC("A")="Select Patient: " D ^DIC G:Y<0 QUIT S D0=+Y
S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Recall Cards by Prov",ZTRTN="DPP^SDRRRECP" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
DPP K ^TMP($J)
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":"**FL",$P(^SD(403.5,D0,0),"^",8)="n":"**NFL",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 BY TEAM
S DIC="^SD(403.55,",DIC(0)="AEQMZ",DIC("A")="Select Clinic Team: " D ^DIC S ZTEAM=+Y G:Y<0 QUIT
S %ZIS="QM" D ^%ZIS G:POP QUIT I $D(IO("Q")) S ZTDESC="Print Nonresponsive Recall Cards by Team",ZTRTN="DQDD^SDRRRECP" S ZTSAVE("*")="" D ^%ZTLOAD G QUIT
DQDD K ^TMP($J)
N CHKDATE
S PR=0 F S PR=$O(^SD(403.5,"C",PR)) Q:PR="" I $P($G(^SD(403.54,PR,0)),U,2)=+ZTEAM S D0=0 F S D0=$O(^SD(403.5,"C",PR,D0)) Q:D0="" S DTA=$G(^SD(403.5,D0,0)) D:DTA]""
.I $P($G(^SD(403.5,D0,0)),"^",10)="" QUIT
.; SD*569 - Prevent from printing more than ONE second card
.I $P($G(^SD(403.5,D0,0)),"^",13)'="" QUIT
.S CHKDATE=5 S RDATE=$P($G(^SD(403.5,D0,0)),"^",6) S CHECK=$$FMDIFF^XLFDT(RDATE,DT) I CHECK>CHKDATE K RDATE QUIT
.S TIME=""
.I $P(^SD(403.5,D0,0),"^",9)["60" S TIME=$P(^SD(403.5,D0,0),"^",9) S TIME="**"_TIME_"**"
.S LAB=$S($P($G(^SD(403.5,D0,0)),"^",8)="f":"**FL",$P(^SD(403.5,D0,0),"^",8)="n":"**NFL",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
SDRRRECP ;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 CARDS this routine
+4 ;;will run.
+5 KILL TYPE
MEN ;SET UP WHAT ARE THEY WOULD LIKE TO PRINT FOR CARDS
+1 KILL DIR,Y,DTOUT,DIROUT,DIRUT,DUOUT
+2 SET DIR(0)="SO^1:Print Cards by Division;2:Print Cards by Clinic;3:Print Cards by Provider;4:Print Cards by Team;5:Print a Card by Patient;6:Print Cards 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 EN3
+6 IF Q=2
GOTO EN
+7 IF Q=3
GOTO EN2
+8 IF Q=4
GOTO EN1
+9 IF Q=5
GOTO EN4
+10 IF Q=6
GOTO EN5
+11 QUIT
+12 ;ALLK Q,Y,DIR
EN3 ;PRINT BY DIVISION
+1 SET DIC="^DG(40.8,"
SET DIC(0)="AEQMZ"
DO ^DIC
IF Y<0
GOTO QUIT
SET DIV=+Y
DO SELDT
IF Y<0
GOTO QUIT
+2 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO QUIT
IF $DATA(IO("Q"))
SET ZTDSC="Print Recall Cards by Division"
SET ZTRTN="DQD1^SDRRRECP"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
GOTO QUIT
DQD1 KILL ^TMP($JOB)
+1 SET PR=0
FOR
SET PR=$ORDER(^SD(403.5,"C",PR))
IF PR=""
QUIT
IF $PIECE($GET(^SD(403.54,PR,0)),"^",3)=DIV
SET D0=0
FOR
SET D0=$ORDER(^SD(403.5,"C",PR,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)["60"
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":"**FL",$PIECE(^SD(403.5,D0,0),"^",8)="n":"**NFL",1:"")
+5 SET DFN=+DTA
+6 IF $$TESTPAT^VADPT(DFN)
QUIT
+7 DO ADD^VADPT
DO DEM^VADPT
+8 SET PN=$PIECE(VADM(1),U)
+9 SET STATE=$PIECE(VAPA(5),"^",1)
SET STATE=$$GET1^DIQ(5,STATE_",",1)
+10 IF $GET(VADM(6),U)'=""
QUIT
+11 IF $PIECE(DTA,"^",6)<SDT!($PIECE(DTA,"^",6)>EDT)
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
EN ;PRINT BY CLINIC
+1 SET DIC="^SC("
SET DIC(0)="AEQMZ"
DO ^DIC
IF Y<0
QUIT
SET DIV=+Y
DO SELDT
IF Y<0
GOTO QUIT
+2 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO QUIT
IF $DATA(IO("Q"))
SET ZTDESC="Print Recall Cards by Clinic"
SET ZTRTN="DQD^SDRRRECP"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
GOTO QUIT
DQD KILL ^TMP($JOB)
+1 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)["60"
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":"**FL",$PIECE(^SD(403.5,D0,0),"^",8)="n":"**NFL",1:"")
+5 SET DFN=+DTA
+6 IF $$TESTPAT^VADPT(DFN)
QUIT
+7 DO ADD^VADPT
DO DEM^VADPT
+8 SET STATE=$PIECE(VAPA(5),"^",1)
SET STATE=$$GET1^DIQ(5,STATE_",",1)
+9 SET PN=$PIECE(VADM(1),U)
+10 IF $GET(VADM(6),U)'=""
QUIT
+11 IF $PIECE(DTA,"^",6)<SDT!($PIECE(DTA,"^",6)>EDT)
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
QUIT KILL ADTA,D0,DFN,DIC,DIR,DIRUT,DTA,I,L,PN,POP,Y,DIV,EDT,PR,SDT,TIME,LAB,Y,STATE
+1 KILL DATE,DOD,X,Q,%DT,%ZIS,SDRR,VA,CHECK,ZTDESC,ZTDSC,ZTEAM,ZTIO,ZTRTN,ZTSAVE
+2 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 WRITE @IOF
FOR L=1:1:7
WRITE !
+1 WRITE !?20,$PIECE($PIECE(PN,",",2)," ",1)_" "_$PIECE(PN,",")
+2 IF $PIECE(VAPA(1),U)'=""
WRITE !?20,$PIECE(VAPA(1),U)
+3 IF $PIECE(VAPA(2),U)'=""
WRITE !?20,$PIECE(VAPA(2),U)
+4 IF $PIECE(VAPA(3),U)'=""
WRITE !?20,$PIECE(VAPA(3),U)
+5 WRITE !?20,$PIECE(VAPA(4),U),", "_STATE_" ",$PIECE(VAPA(6),U)
+6 IF TIME'=""
WRITE !!?45,TIME
+7 IF LAB'=""
WRITE !!?45,LAB
+8 QUIT
EN1 ;PRINT BY TEAM
+1 SET DIC="^SD(403.55,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Clinic Team: "
DO ^DIC
IF Y<0
QUIT
SET ZTEAM=+Y
DO SELDT
IF Y<0
GOTO QUIT
+2 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO QUIT
IF $DATA(IO("Q"))
SET ZTDESC="Print Recall Cards by Team"
SET ZTRTN="DQT^SDRRRECP"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
GOTO QUIT
DQT KILL ^TMP($JOB)
+1 SET PR=0
FOR
SET PR=$ORDER(^SD(403.5,"C",PR))
IF PR=""
QUIT
IF $PIECE($GET(^SD(403.54,PR,0)),U,2)=+ZTEAM
SET D0=0
FOR
SET D0=$ORDER(^SD(403.5,"C",PR,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)["60"
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":"**FL",$PIECE(^SD(403.5,D0,0),"^",8)="n":"**NFL",1:"")
+5 SET DFN=+DTA
+6 IF $$TESTPAT^VADPT(DFN)
QUIT
+7 DO ADD^VADPT
DO DEM^VADPT
+8 SET PN=$PIECE(VADM(1),U)
+9 SET STATE=$PIECE(VAPA(5),"^",1)
SET STATE=$$GET1^DIQ(5,STATE_",",1)
+10 IF $GET(VADM(6),U)'=""
QUIT
+11 IF $PIECE(DTA,"^",6)<SDT!($PIECE(DTA,"^",6)>EDT)
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
+17 DO ^%ZISC
GOTO QUIT
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
EN2 ;PRINT BY PROV
+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
DO SELDT
IF Y<0
GOTO QUIT
+2 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO QUIT
IF $DATA(IO("Q"))
SET ZTDESC="Print Recall Cards by Prov"
SET ZTRTN="DQP^SDRRRECP"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
GOTO QUIT
DQP KILL ^TMP($JOB)
+1 SET D0=0
FOR
SET D0=$ORDER(^SD(403.5,"C",PR,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":"**FL",$PIECE(^SD(403.5,D0,0),"^",8)="n":"**NFL",1:"")
+5 SET DFN=+DTA
+6 IF $$TESTPAT^VADPT(DFN)
QUIT
+7 DO ADD^VADPT
DO DEM^VADPT
+8 SET STATE=$PIECE(VAPA(5),"^",1)
SET STATE=$$GET1^DIQ(5,STATE_",",1)
+9 SET PN=$PIECE(VADM(1),U)
+10 IF $GET(VADM(6),U)'=""
QUIT
+11 IF $PIECE(DTA,"^",6)<SDT!($PIECE(DTA,"^",6)>EDT)
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
EN4 ;PRINT BY Patient
+1 WRITE !
SET DIC="^SD(403.5,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Patient: "
DO ^DIC
IF Y<0
GOTO QUIT
SET D0=+Y
+2 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO QUIT
IF $DATA(IO("Q"))
SET ZTDESC="Print Recall Cards by Prov"
SET ZTRTN="DPP^SDRRRECP"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
GOTO QUIT
DPP KILL ^TMP($JOB)
+1 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":"**FL",$PIECE(^SD(403.5,D0,0),"^",8)="n":"**NFL",1:"")
+5 SET DFN=+DTA
+6 IF $$TESTPAT^VADPT(DFN)
QUIT
+7 DO ADD^VADPT
DO DEM^VADPT
+8 SET STATE=$PIECE(VAPA(5),"^",1)
SET STATE=$$GET1^DIQ(5,STATE_",",1)
+9 SET PN=$PIECE(VADM(1),U)
+10 IF $GET(VADM(6),U)'=""
QUIT
+11 SET CHECK=$$BADADR^DGUTL3
IF CHECK>0
SET XMSUB="Bad Address for Recall Reminder Patient"
SET XMTEXT="SDRR("
Begin DoDot:2
+12 SET XMY("G.SDRR BAD ADDRESS")=""
SET XMDUZ=.5
+13 SET SDRR(1)="Bad Address- card will not be printed for:"_" "_PN_" "_VA("BID")
+14 DO ^XMD
+15 KILL XMY,XMSUB,XMTEXT,XMDUZ
End DoDot:2
+16 ;ADDED THE DATE INFORMATION
+17 SET $PIECE(^SD(403.5,D0,0),"^",10)=DT
+18 DO PR
End DoDot:1
+19 DO ^%ZISC
GOTO QUIT
EN5 ;PRINT BY TEAM
+1 SET DIC="^SD(403.55,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select Clinic Team: "
DO ^DIC
SET ZTEAM=+Y
IF Y<0
GOTO QUIT
+2 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO QUIT
IF $DATA(IO("Q"))
SET ZTDESC="Print Nonresponsive Recall Cards by Team"
SET ZTRTN="DQDD^SDRRRECP"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
GOTO QUIT
DQDD KILL ^TMP($JOB)
+1 NEW CHKDATE
+2 SET PR=0
FOR
SET PR=$ORDER(^SD(403.5,"C",PR))
IF PR=""
QUIT
IF $PIECE($GET(^SD(403.54,PR,0)),U,2)=+ZTEAM
SET D0=0
FOR
SET D0=$ORDER(^SD(403.5,"C",PR,D0))
IF D0=""
QUIT
SET DTA=$GET(^SD(403.5,D0,0))
IF DTA]""
Begin DoDot:1
+3 IF $PIECE($GET(^SD(403.5,D0,0)),"^",10)=""
QUIT
+4 ; SD*569 - Prevent from printing more than ONE second card
+5 IF $PIECE($GET(^SD(403.5,D0,0)),"^",13)'=""
QUIT
+6 SET CHKDATE=5
SET RDATE=$PIECE($GET(^SD(403.5,D0,0)),"^",6)
SET CHECK=$$FMDIFF^XLFDT(RDATE,DT)
IF CHECK>CHKDATE
KILL RDATE
QUIT
+7 SET TIME=""
+8 IF $PIECE(^SD(403.5,D0,0),"^",9)["60"
SET TIME=$PIECE(^SD(403.5,D0,0),"^",9)
SET TIME="**"_TIME_"**"
+9 SET LAB=$SELECT($PIECE($GET(^SD(403.5,D0,0)),"^",8)="f":"**FL",$PIECE(^SD(403.5,D0,0),"^",8)="n":"**NFL",1:"")
+10 SET DFN=+DTA
+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),"^",13)=DT
+23 DO PR
End DoDot:1
+24 DO ^%ZISC
GOTO QUIT
+25 QUIT
