Routine: SDRRRECP

SDRRRECP ;10N20/MAH - Recall Reminder Manual Printing;09/20/2004

 ;;5.3;Scheduling;**536,569,579,654,685**;Aug 13, 1993;Build 3

 ;;This routine is called from SDRRLRP

 ;;If the site has set TYPE OF NOTIFICATION to CARDS this routine

 ;;will run.

 ; SD*654

 ; - do not update date if card printed to a computer screen.

 ; - adds missing var DFN when calling $$BARADR^DGUTL3 and

 ;   quits printing if bad addr.

 ; - fixes incomplete Canadian address

 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

 ;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)

 .; SD*654 - add missing var DFN

 .;        - quit updating date and printing card if bad addr

 .S CHECK=$$BADADR^DGUTL3(DFN) I CHECK>0 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D  Q

 ..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

 .; SD*654 - do not update date if card printed to a computer screen.

 .I $E(IOST,1,2)'="C-" 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)

 .; SD*654 - add missing var DFN

 .;        - quit updating date and printing card if bad addr

 .S CHECK=$$BADADR^DGUTL3(DFN) I CHECK>0 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D  Q

 ..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

 .; SD*654 - do not update date if card printed to a computer screen.

 .I $E(IOST,1,2)'="C-" 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,PNAME

 K DATE,DOD,X,Q,%DT,%ZIS,SDRR,VA,CHECK,ZTDESC,ZTDSC,ZTEAM,ZTIO,ZTRTN,ZTSAVE

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 !

 S PNAME=$$NAMEFMT^XLFNAME(PN,"G","")

 W !?20,PNAME

 D ADDR

 I TIME'="" W !!?45,TIME

 I LAB'="" W !!?45,LAB

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)

 .; SD*654 - add missing var DFN

 .;        - quit updating date and printing card if bad addr

 .S CHECK=$$BADADR^DGUTL3(DFN) I CHECK>0 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D  Q

 ..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

 .; SD*654 - do not update date if card printed to a computer screen.

 .I $E(IOST,1,2)'="C-" 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)

 .; SD*654 - add missing var DFN

 .;        - quit updating date and printing card if bad addr

 .S CHECK=$$BADADR^DGUTL3(DFN) I CHECK>0 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D  Q

 ..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

 .; SD*654 - do not update date if card printed to a computer screen.

 .I $E(IOST,1,2)'="C-" 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

 ; SD*654 - Check if it needs to quit before prompting for device

 S DFN=+$G(^SD(403.5,D0,0))

 I $$TESTPAT^VADPT(DFN) W !!,?5,"**You may have selected a test patient.**",!! G QUIT  ; quit if test pat

 D DEM^VADPT

 S PN=$P(VADM(1),U)

 ; SD*654 - add missing var DFN

 ;        - quit updating date and printing card if bad addr

 S CHECK=$$BADADR^DGUTL3(DFN) I CHECK>0 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D  W !!,?5,"**This patient has been flagged with a Bad Address Indicator.**",!! G QUIT

 . 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

 I $G(VADM(6),U)'="" W !!,?5,VADM(7),!! G QUIT  ; quit if DoD

 ; SD*654 - end

 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

 .D ADD^VADPT,DEM^VADPT

 .S STATE=$P(VAPA(5),"^",1),STATE=$$GET1^DIQ(5,STATE_",",1)

 .S PN=$P(VADM(1),U)

 .;ADDED THE DATE INFORMATION

 .; SD*654 - do not update date if card printed to a computer screen.

 .I $E(IOST,1,2)'="C-" S $P(^SD(403.5,D0,0),"^",10)=DT

 .D PR

 D ^%ZISC G QUIT

EN5 ;PRINT BY NONRESPONSIVE PATIENTS

 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

 .; SD*654 - add missing var DFN

 .;        - quit updating date and printing card if bad addr

 .S CHECK=$$BADADR^DGUTL3(DFN) I CHECK>0 S XMSUB="Bad Address for Recall Reminder Patient",XMTEXT="SDRR(" D  Q

 ..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

 .; SD*654 - do not update date if card printed to a computer screen.

 .I $E(IOST,1,2)'="C-" S $P(^SD(403.5,D0,0),"^",13)=DT

 .D PR

 D ^%ZISC G QUIT

ADDR ; SD*654 Patient address

 ; Change state to abbr.

 N SDRRIENS,SDRRX

 I $D(VAPA(5)) S SDRRIENS=+VAPA(5)_",",SDRRX=$$GET1^DIQ(5,SDRRIENS,1),$P(VAPA(5),U,2)=SDRRX

 I $D(VAPA(17)) S SDRRIENS=+VAPA(17)_",",SDRRX=$$GET1^DIQ(5,SDRRIENS,1),$P(VAPA(17),U,2)=SDRRX

 K SDRRIENS,SDRRX

 N SDRRACT1,SDRRACT2,LL

 ; Check Confidential Address Indicator (0=Inactive,1=Active)

 S SDRRACT1=VAPA(12),SDRRACT2=$P($G(VAPA(22,2)),U,3)

 ; If Confidential address is not active, print regular address

 I ($G(SDRRACT1)=0)!($G(SDRRACT2)'="Y") D

 . F LL=1:1:3 W:VAPA(LL)]"" !,?20,VAPA(LL)

 . ; If country is blank, display as USA

 . I (VAPA(25)="")!($P(VAPA(25),U,2)="UNITED STATES") D

 . . ; Display city, state, zip

 . . W !?20,VAPA(4)_" "_$P(VAPA(5),U,2)_"  "_$P(VAPA(11),U,2)

 . E  D

 . . ; Display city, province, postal code

 . . W !?20,VAPA(4)_" "_VAPA(23)_"  "_VAPA(24)

 . ; Display country

 . W:($P(VAPA(25),U,2)'="UNITED STATES") !,?20,$P(VAPA(25),U,2)

 ; If Confidential address is active, print confidential address

 I $G(SDRRACT1)=1,$G(SDRRACT2)="Y" D

 . F LL=13:1:15 W:VAPA(LL)]"" !,?20,VAPA(LL) ;*685

 . I (VAPA(28)="")!($P(VAPA(28),"^",2)="UNITED STATES") D

 . . W !,?20,VAPA(16)_" "_$P(VAPA(17),U,2)_"  "_$P(VAPA(18),U,2)

 . E  D

 . . W !,?20,VAPA(27)_" "_VAPA(16)_" "_VAPA(26)

 . I ($P(VAPA(28),"^",2)'="UNITED STATES") W !?20,$P(VAPA(28),U,2)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRRRECP   11658     printed  Mar 13, 2025@22:05:59                                                                                                                                                                                                   Page 2

SDRRRECP  ;10N20/MAH - Recall Reminder Manual Printing;09/20/2004

 +1       ;;5.3;Scheduling;**536,569,579,654,685**;Aug 13, 1993;Build 3

 +2       ;;This routine is called from SDRRLRP

 +3       ;;If the site has set TYPE OF NOTIFICATION to CARDS this routine

 +4       ;;will run.

 +5       ;

 +6       ; SD*654

 +7       ; - do not update date if card printed to a computer screen.

 +8       ; - adds missing var DFN when calling $$BARADR^DGUTL3 and

 +9       ;   quits printing if bad addr.

 +10      ; - fixes incomplete Canadian address

 +11      ;

 +12       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      ; SD*654 - add missing var DFN

 +13      ;        - quit updating date and printing card if bad addr

 +14                           SET CHECK=$$BADADR^DGUTL3(DFN)

                               IF CHECK>0

                                   SET XMSUB="Bad Address for Recall Reminder Patient"

                                   SET XMTEXT="SDRR("

                                   Begin DoDot:2

 +15                                   SET XMY("G.SDRR BAD ADDRESS")=""

                                       SET XMDUZ=.5

 +16                                   SET SDRR(1)="Bad Address- card will not be printed for:"_"   "_PN_"   "_VA("BID")

 +17                                   DO ^XMD

 +18                                   KILL XMY,XMSUB,XMTEXT,XMDUZ

                                   End DoDot:2

                                   QUIT

 +19      ;ADDED THE DATE INFORMATION

 +20      ; SD*654 - do not update date if card printed to a computer screen.

 +21                           IF $EXTRACT(IOST,1,2)'="C-"

                                   SET $PIECE(^SD(403.5,D0,0),"^",10)=DT

 +22                           DO PR

                           End DoDot:1

 +23       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      ; SD*654 - add missing var DFN

 +13      ;        - quit updating date and printing card if bad addr

 +14                   SET CHECK=$$BADADR^DGUTL3(DFN)

                       IF CHECK>0

                           SET XMSUB="Bad Address for Recall Reminder Patient"

                           SET XMTEXT="SDRR("

                           Begin DoDot:2

 +15                           SET XMY("G.SDRR BAD ADDRESS")=""

                               SET XMDUZ=.5

 +16                           SET SDRR(1)="Bad Address- card will not be printed for:"_"   "_PN_"   "_VA("BID")

 +17                           DO ^XMD

 +18                           KILL XMY,XMSUB,XMTEXT,XMDUZ

                           End DoDot:2

                           QUIT

 +19      ;ADDED THE DATE INFORMATION

 +20      ; SD*654 - do not update date if card printed to a computer screen.

 +21                   IF $EXTRACT(IOST,1,2)'="C-"

                           SET $PIECE(^SD(403.5,D0,0),"^",10)=DT

 +22                   DO PR

                   End DoDot:1

 +23       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,PNAME

 +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        SET PNAME=$$NAMEFMT^XLFNAME(PN,"G","")

 +2        WRITE !?20,PNAME

 +3        DO ADDR

 +4        IF TIME'=""

               WRITE !!?45,TIME

 +5        IF LAB'=""

               WRITE !!?45,LAB

 +6        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      ; SD*654 - add missing var DFN

 +13      ;        - quit updating date and printing card if bad addr

 +14                           SET CHECK=$$BADADR^DGUTL3(DFN)

                               IF CHECK>0

                                   SET XMSUB="Bad Address for Recall Reminder Patient"

                                   SET XMTEXT="SDRR("

                                   Begin DoDot:2

 +15                                   SET XMY("G.SDRR BAD ADDRESS")=""

                                       SET XMDUZ=.5

 +16                                   SET SDRR(1)="Bad Address- card will not be printed for:"_"   "_PN_"   "_VA("BID")

 +17                                   DO ^XMD

 +18                                   KILL XMY,XMSUB,XMTEXT,XMDUZ

 +19      ;D ^%ZISC G QUIT

                                   End DoDot:2

                                   QUIT

 +20      ;ADDED THE DATE INFORMATION

 +21      ; SD*654 - do not update date if card printed to a computer screen.

 +22                           IF $EXTRACT(IOST,1,2)'="C-"

                                   SET $PIECE(^SD(403.5,D0,0),"^",10)=DT

 +23                           DO PR

                           End DoDot:1

 +24       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      ; SD*654 - add missing var DFN

 +13      ;        - quit updating date and printing card if bad addr

 +14                   SET CHECK=$$BADADR^DGUTL3(DFN)

                       IF CHECK>0

                           SET XMSUB="Bad Address for Recall Reminder Patient"

                           SET XMTEXT="SDRR("

                           Begin DoDot:2

 +15                           SET XMY("G.SDRR BAD ADDRESS")=""

                               SET XMDUZ=.5

 +16                           SET SDRR(1)="Bad Address- card will not be printed for:"_"   "_PN_"   "_VA("BID")

 +17                           DO ^XMD

 +18                           KILL XMY,XMSUB,XMTEXT,XMDUZ

                           End DoDot:2

                           QUIT

 +19      ;ADDED THE DATE INFORMATION

 +20      ; SD*654 - do not update date if card printed to a computer screen.

 +21                   IF $EXTRACT(IOST,1,2)'="C-"

                           SET $PIECE(^SD(403.5,D0,0),"^",10)=DT

 +22                   DO PR

                   End DoDot:1

 +23       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       ;

 +3       ; SD*654 - Check if it needs to quit before prompting for device

 +4        SET DFN=+$GET(^SD(403.5,D0,0))

 +5       ; quit if test pat

           IF $$TESTPAT^VADPT(DFN)

               WRITE !!,?5,"**You may have selected a test patient.**",!!

               GOTO QUIT

 +6        DO DEM^VADPT

 +7        SET PN=$PIECE(VADM(1),U)

 +8       ; SD*654 - add missing var DFN

 +9       ;        - quit updating date and printing card if bad addr

 +10       SET CHECK=$$BADADR^DGUTL3(DFN)

           IF CHECK>0

               SET XMSUB="Bad Address for Recall Reminder Patient"

               SET XMTEXT="SDRR("

               Begin DoDot:1

 +11               SET XMY("G.SDRR BAD ADDRESS")=""

                   SET XMDUZ=.5

 +12               SET SDRR(1)="Bad Address - card will not be printed for:"_"    "_PN_"    "_VA("BID")

 +13               DO ^XMD

 +14               KILL XMY,XMSUB,XMTEXT,XMDUZ

               End DoDot:1

               WRITE !!,?5,"**This patient has been flagged with a Bad Address Indicator.**",!!

               GOTO QUIT

 +15      ; quit if DoD

           IF $GET(VADM(6),U)'=""

               WRITE !!,?5,VADM(7),!!

               GOTO QUIT

 +16      ; SD*654 - end

 +17      ;

 +18       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                DO ADD^VADPT

                   DO DEM^VADPT

 +7                SET STATE=$PIECE(VAPA(5),"^",1)

                   SET STATE=$$GET1^DIQ(5,STATE_",",1)

 +8                SET PN=$PIECE(VADM(1),U)

 +9       ;ADDED THE DATE INFORMATION

 +10      ; SD*654 - do not update date if card printed to a computer screen.

 +11               IF $EXTRACT(IOST,1,2)'="C-"

                       SET $PIECE(^SD(403.5,D0,0),"^",10)=DT

 +12               DO PR

               End DoDot:1

 +13       DO ^%ZISC

           GOTO QUIT

EN5       ;PRINT BY NONRESPONSIVE PATIENTS

 +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      ; SD*654 - add missing var DFN

 +17      ;        - quit updating date and printing card if bad addr

 +18                           SET CHECK=$$BADADR^DGUTL3(DFN)

                               IF CHECK>0

                                   SET XMSUB="Bad Address for Recall Reminder Patient"

                                   SET XMTEXT="SDRR("

                                   Begin DoDot:2

 +19                                   SET XMY("G.SDRR BAD ADDRESS")=""

                                       SET XMDUZ=.5

 +20                                   SET SDRR(1)="Bad Address- card will not be printed for:"_"   "_PN_"   "_VA("BID")

 +21                                   DO ^XMD

 +22                                   KILL XMY,XMSUB,XMTEXT,XMDUZ

                                   End DoDot:2

                                   QUIT

 +23      ;ADDED THE DATE INFORMATION

 +24      ; SD*654 - do not update date if card printed to a computer screen.

 +25                           IF $EXTRACT(IOST,1,2)'="C-"

                                   SET $PIECE(^SD(403.5,D0,0),"^",13)=DT

 +26                           DO PR

                           End DoDot:1

 +27       DO ^%ZISC

           GOTO QUIT

 +28       QUIT

 +29      ;

ADDR      ; SD*654 Patient address

 +1       ; Change state to abbr.

 +2        NEW SDRRIENS,SDRRX

 +3        IF $DATA(VAPA(5))

               SET SDRRIENS=+VAPA(5)_","

               SET SDRRX=$$GET1^DIQ(5,SDRRIENS,1)

               SET $PIECE(VAPA(5),U,2)=SDRRX

 +4        IF $DATA(VAPA(17))

               SET SDRRIENS=+VAPA(17)_","

               SET SDRRX=$$GET1^DIQ(5,SDRRIENS,1)

               SET $PIECE(VAPA(17),U,2)=SDRRX

 +5        KILL SDRRIENS,SDRRX

 +6       ;

 +7        NEW SDRRACT1,SDRRACT2,LL

 +8       ; Check Confidential Address Indicator (0=Inactive,1=Active)

 +9        SET SDRRACT1=VAPA(12)

           SET SDRRACT2=$PIECE($GET(VAPA(22,2)),U,3)

 +10      ; If Confidential address is not active, print regular address

 +11       IF ($GET(SDRRACT1)=0)!($GET(SDRRACT2)'="Y")

               Begin DoDot:1

 +12               FOR LL=1:1:3

                       if VAPA(LL)]""

                           WRITE !,?20,VAPA(LL)

 +13      ; If country is blank, display as USA

 +14               IF (VAPA(25)="")!($PIECE(VAPA(25),U,2)="UNITED STATES")

                       Begin DoDot:2

 +15      ; Display city, state, zip

 +16                       WRITE !?20,VAPA(4)_" "_$PIECE(VAPA(5),U,2)_"  "_$PIECE(VAPA(11),U,2)

                       End DoDot:2

 +17              IF '$TEST

                       Begin DoDot:2

 +18      ; Display city, province, postal code

 +19                       WRITE !?20,VAPA(4)_" "_VAPA(23)_"  "_VAPA(24)

                       End DoDot:2

 +20      ; Display country

 +21               if ($PIECE(VAPA(25),U,2)'="UNITED STATES")

                       WRITE !,?20,$PIECE(VAPA(25),U,2)

               End DoDot:1

 +22      ; If Confidential address is active, print confidential address

 +23       IF $GET(SDRRACT1)=1

               IF $GET(SDRRACT2)="Y"

                   Begin DoDot:1

 +24      ;*685

                       FOR LL=13:1:15

                           if VAPA(LL)]""

                               WRITE !,?20,VAPA(LL)

 +25                   IF (VAPA(28)="")!($PIECE(VAPA(28),"^",2)="UNITED STATES")

                           Begin DoDot:2

 +26                           WRITE !,?20,VAPA(16)_" "_$PIECE(VAPA(17),U,2)_"  "_$PIECE(VAPA(18),U,2)

                           End DoDot:2

 +27                  IF '$TEST

                           Begin DoDot:2

 +28                           WRITE !,?20,VAPA(27)_" "_VAPA(16)_" "_VAPA(26)

                           End DoDot:2

 +29                   IF ($PIECE(VAPA(28),"^",2)'="UNITED STATES")

                           WRITE !?20,$PIECE(VAPA(28),U,2)

                   End DoDot:1

 +30       QUIT

SDRRRECP.m