SDRRISRD ;10N20/MAH;-Recall List Delinquencies ;01/18/2008 11:32
;;5.3;Scheduling;**536**;Aug 13, 1993;Build 53
;
; Option: SDRR RECALL DELINQUENCIES
EN ;
N SDRRST,SDRRND,SDRRSTX,SDRRNDX,SDRRBRK,SDRRABORT,I,ZTSAVE,XMDUZ,XMSUB,ZTSK,VA,VADM,VAPA
N SDRRDIV,SDRRDAYS,DIR,X,Y,Z,ZTDESC,ZTQUEUED
S SDRRABORT=0
W !!,"Select a time period and a set of clinics, and I'll tell you all the"
W !,"patients who are on the Recall List for that time period at those clinics"
W !,"who've been sent reminders, but haven't yet made an appointment."
W !!,"First select the Recall Date range."
S SDRRND=$$FMADD^XLFDT(DT,-1)
D DRANGE^SDRRUTL(.SDRRST,.SDRRND,.SDRRSTX,.SDRRNDX,.SDRRABORT) Q:SDRRABORT
K ^TMP("SDRR",$J)
D ASKDIV^SDRRPXC(.SDRRDIV) Q:'SDRRDIV
D ASKCLIN^SDRRPXC(.SDRRDIV,SDRRST,SDRRND) Q:'$D(^TMP("SDRR",$J))
W !
K DIR,X,Y
S DIR(0)="Y"
S DIR("A")="Page break on clinic"
S DIR("B")="Yes"
D ^DIR Q:$D(DIRUT)
K DIRUT
S SDRRBRK=Y ; Page break on Clinic
S XMSUB="Recall Delinquency List, "_$S(SDRRST=SDRRND:SDRRSTX,1:SDRRSTX_"-"_SDRRNDX)
F I="SDRRDIV","SDRRDIV(","SDRRST","SDRRSTX","SDRRND","SDRRNDX","SDRRBRK","SDRRDAYS","^TMP(""SDRR"",$J," S ZTSAVE(I)=""
D EN^XUTMDEVQ("CONTROL^SDRRISRD",XMSUB,.ZTSAVE,,1)
I '$D(ZTQUEUED),$D(ZTSK) W !,"Request queued. (Task: ",ZTSK,")"
Q
CONTROL ;
N SDRRIA,SDRRCLIST
S SDRRIA=$E($G(IOST),1,2)="C-"
D CLINLIST^SDRRISB(.SDRRCLIST)
D GATHER
D PRINT
K ^TMP("SDRR",$J)
Q
GATHER ; Gather Patient from Recall List
N SDRRDT,SDRRIEN,SDRRDFN,SDRRREC,SDRRDFN0,SDRRCLIN,SDRRSDT,SDRRPH,SDRRDDAYS,DFN,VA,VADM,VAPA
S SDRRND=SDRRND+.9999
S SDRRDT=SDRRST-.1
S SDRRIEN="" ; "D" xref is on the RECALL DATE field
F S SDRRDT=$O(^SD(403.5,"D",SDRRDT)) Q:SDRRDT>SDRRND!'SDRRDT D
. F S SDRRIEN=$O(^SD(403.5,"D",SDRRDT,SDRRIEN)) Q:'SDRRIEN D
. . S SDRRREC=$G(^SD(403.5,SDRRIEN,0))
. . S SDRRCLIN=+$P(SDRRREC,U,2)
. . Q:'$D(SDRRCLIST(SDRRCLIN)) ; Must be clinic we want
. . S SDRRSDT=$P(SDRRREC,U,10) ; Reminder sent date
. . S Z=$P(SDRRREC,U,13) I Z'="" S Z="*"
. . Q:'SDRRSDT ; Reminder must have been sent
. . S SDRRDFN=+SDRRREC
. . Q:$$TESTPAT^VADPT(SDRRDFN) ; Test patient
. . S DFN=SDRRDFN
. . D ADD^VADPT,DEM^VADPT
. . Q:$G(VADM(6),U)'=""
. . S SDRRDDAYS=$$FMDIFF^XLFDT(DT,SDRRDT)
. . N SDRRPW
. . S SDRRPW="" S SDRRPW=$$GET1^DIQ(2,DFN_",",.132)
. . S ^TMP("SDRR",$J,"PRT",SDRRCLIST(SDRRCLIN)_U_SDRRCLIN,SDRRDDAYS,$P(VADM(1),U)_U_SDRRDFN)=$P(VA("BID"),U)_U_$P(VAPA(8),U,1)_U_SDRRPW_U_SDRRDT_U_Z_U_SDRRSDT
D KVAR^VADPT
Q
PRINT ;
N SDRRTODAY,SDRRCLIN,SDRRCLSAV,SDRRDT,SDRRREC,SDRRPAGE,SDRRABORT,SDRRDR,SDRRRP
N SDRRPAT,SDRRSSN,SDRRCNT,SDRRDTX,SDRRPH,SDRRPW,SDRRSDT,SDRRDDAYS,SDRRPROV
S (SDRRABORT,SDRRPAGE)=0
I SDRRIA W @IOF
S SDRRTODAY=$$FMTE^XLFDT(DT)
S SDRRDR=$$CJ^XLFSTR(ZTDESC,IOM-1)
S $E(SDRRDR,1,$L(SDRRTODAY))=SDRRTODAY
S SDRRDR=$E(SDRRDR,1,IOM-8)_"Page"
D HEADER
I '$D(^TMP("SDRR",$J,"PRT")) W !,"No Recall Delinquencies found for this date range." Q
S (SDRRCLIN,SDRRPAT,SDRRDDAYS)=""
S SDRRCLSAV=SDRRCLIN
F S SDRRCLIN=$O(^TMP("SDRR",$J,"PRT",SDRRCLIN)) Q:SDRRCLIN="" D Q:SDRRABORT
. I SDRRCLSAV'="",SDRRBRK!($Y+4+SDRRIA>IOSL) D Q:SDRRABORT
. . I SDRRIA D PAGE^XMXUTIL(.SDRRABORT) Q:SDRRABORT
. . W @IOF D HEADER
. S SDRRCLSAV=SDRRCLIN
. S SDRRPROV=$$PRDEF^SDCO31($P(SDRRCLIN,U,2))
. I SDRRPROV="" S SDRRPROV="(No Default Provider)"
. W !!,$$CJ^XLFSTR(" "_$P(SDRRCLIN,U)_" "_SDRRPROV_" ",79,"-")
. S SDRRCNT=0
. F S SDRRDDAYS=$O(^TMP("SDRR",$J,"PRT",SDRRCLIN,SDRRDDAYS),-1) Q:SDRRDDAYS="" D Q:SDRRABORT
. . F S SDRRPAT=$O(^TMP("SDRR",$J,"PRT",SDRRCLIN,SDRRDDAYS,SDRRPAT)) Q:SDRRPAT="" S SDRRREC=^(SDRRPAT) D Q:SDRRABORT
. . . S SDRRCNT=SDRRCNT+1
. . . S SDRRSSN=$E(SDRRREC,1,4)
. . . S SDRRPH=$P(SDRRREC,U,2)
. . . S SDRRPW=$P(SDRRREC,U,3)
. . . S SDRRDT=$P(SDRRREC,U,4)
. . . S SDRRRP=$P(SDRRREC,U,5)
. . . S SDRRSDT=$P(SDRRREC,U,6)
. . . I $Y+2+SDRRIA>IOSL D Q:SDRRABORT
. . . . I SDRRIA D PAGE^XMXUTIL(.SDRRABORT) Q:SDRRABORT
. . . . W @IOF D HEADER
. . . W !,$E($P(SDRRPAT,U),1,14),?15,SDRRSSN,?20,$E(SDRRPH,1,18),?38,$E(SDRRPW,1,20),?58,$$FMTE^XLFDT(SDRRDT,"2Z"),?66,$J(SDRRDDAYS,4),?71,SDRRRP_$$FMTE^XLFDT(SDRRSDT,"2Z")
. Q:SDRRABORT
. D SUBTOT
Q:SDRRABORT
I SDRRIA D WAIT^XMXUTIL
Q
S SDRRPAGE=SDRRPAGE+1
W SDRRDR,$J(SDRRPAGE,3)
W !!,?71,"Reminder"
W !,"Patient",?15,"SSN",?20,"Home Phone",?38,"Work Phone",?58,"Recall",?66,"Days",?71,"Sent"
Q
SUBTOT ;
I $Y+3+SDRRIA>IOSL D Q:SDRRABORT
. I SDRRIA D PAGE^XMXUTIL(.SDRRABORT) Q:SDRRABORT
. W @IOF D HEADER
W !!,"Delinquent Patient Recalls: ",SDRRCNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRRISRD 4669 printed Nov 22, 2024@18:10:38 Page 2
SDRRISRD ;10N20/MAH;-Recall List Delinquencies ;01/18/2008 11:32
+1 ;;5.3;Scheduling;**536**;Aug 13, 1993;Build 53
+2 ;
+3 ; Option: SDRR RECALL DELINQUENCIES
EN ;
+1 NEW SDRRST,SDRRND,SDRRSTX,SDRRNDX,SDRRBRK,SDRRABORT,I,ZTSAVE,XMDUZ,XMSUB,ZTSK,VA,VADM,VAPA
+2 NEW SDRRDIV,SDRRDAYS,DIR,X,Y,Z,ZTDESC,ZTQUEUED
+3 SET SDRRABORT=0
+4 WRITE !!,"Select a time period and a set of clinics, and I'll tell you all the"
+5 WRITE !,"patients who are on the Recall List for that time period at those clinics"
+6 WRITE !,"who've been sent reminders, but haven't yet made an appointment."
+7 WRITE !!,"First select the Recall Date range."
+8 SET SDRRND=$$FMADD^XLFDT(DT,-1)
+9 DO DRANGE^SDRRUTL(.SDRRST,.SDRRND,.SDRRSTX,.SDRRNDX,.SDRRABORT)
if SDRRABORT
QUIT
+10 KILL ^TMP("SDRR",$JOB)
+11 DO ASKDIV^SDRRPXC(.SDRRDIV)
if 'SDRRDIV
QUIT
+12 DO ASKCLIN^SDRRPXC(.SDRRDIV,SDRRST,SDRRND)
if '$DATA(^TMP("SDRR",$JOB))
QUIT
+13 WRITE !
+14 KILL DIR,X,Y
+15 SET DIR(0)="Y"
+16 SET DIR("A")="Page break on clinic"
+17 SET DIR("B")="Yes"
+18 DO ^DIR
if $DATA(DIRUT)
QUIT
+19 KILL DIRUT
+20 ; Page break on Clinic
SET SDRRBRK=Y
+21 SET XMSUB="Recall Delinquency List, "_$SELECT(SDRRST=SDRRND:SDRRSTX,1:SDRRSTX_"-"_SDRRNDX)
+22 FOR I="SDRRDIV","SDRRDIV(","SDRRST","SDRRSTX","SDRRND","SDRRNDX","SDRRBRK","SDRRDAYS","^TMP(""SDRR"",$J,"
SET ZTSAVE(I)=""
+23 DO EN^XUTMDEVQ("CONTROL^SDRRISRD",XMSUB,.ZTSAVE,,1)
+24 IF '$DATA(ZTQUEUED)
IF $DATA(ZTSK)
WRITE !,"Request queued. (Task: ",ZTSK,")"
+25 QUIT
CONTROL ;
+1 NEW SDRRIA,SDRRCLIST
+2 SET SDRRIA=$EXTRACT($GET(IOST),1,2)="C-"
+3 DO CLINLIST^SDRRISB(.SDRRCLIST)
+4 DO GATHER
+5 DO PRINT
+6 KILL ^TMP("SDRR",$JOB)
+7 QUIT
GATHER ; Gather Patient from Recall List
+1 NEW SDRRDT,SDRRIEN,SDRRDFN,SDRRREC,SDRRDFN0,SDRRCLIN,SDRRSDT,SDRRPH,SDRRDDAYS,DFN,VA,VADM,VAPA
+2 SET SDRRND=SDRRND+.9999
+3 SET SDRRDT=SDRRST-.1
+4 ; "D" xref is on the RECALL DATE field
SET SDRRIEN=""
+5 FOR
SET SDRRDT=$ORDER(^SD(403.5,"D",SDRRDT))
if SDRRDT>SDRRND!'SDRRDT
QUIT
Begin DoDot:1
+6 FOR
SET SDRRIEN=$ORDER(^SD(403.5,"D",SDRRDT,SDRRIEN))
if 'SDRRIEN
QUIT
Begin DoDot:2
+7 SET SDRRREC=$GET(^SD(403.5,SDRRIEN,0))
+8 SET SDRRCLIN=+$PIECE(SDRRREC,U,2)
+9 ; Must be clinic we want
if '$DATA(SDRRCLIST(SDRRCLIN))
QUIT
+10 ; Reminder sent date
SET SDRRSDT=$PIECE(SDRRREC,U,10)
+11 SET Z=$PIECE(SDRRREC,U,13)
IF Z'=""
SET Z="*"
+12 ; Reminder must have been sent
if 'SDRRSDT
QUIT
+13 SET SDRRDFN=+SDRRREC
+14 ; Test patient
if $$TESTPAT^VADPT(SDRRDFN)
QUIT
+15 SET DFN=SDRRDFN
+16 DO ADD^VADPT
DO DEM^VADPT
+17 if $GET(VADM(6),U)'=""
QUIT
+18 SET SDRRDDAYS=$$FMDIFF^XLFDT(DT,SDRRDT)
+19 NEW SDRRPW
+20 SET SDRRPW=""
SET SDRRPW=$$GET1^DIQ(2,DFN_",",.132)
+21 SET ^TMP("SDRR",$JOB,"PRT",SDRRCLIST(SDRRCLIN)_U_SDRRCLIN,SDRRDDAYS,$PIECE(VADM(1),U)_U_SDRRDFN)=$PIECE(VA("BID"),U)_U_$PIECE(VAPA(8),U,1)_U_SDRRPW_U_SDRRDT_U_Z_U_SDRRSDT
End DoDot:2
End DoDot:1
+22 DO KVAR^VADPT
+23 QUIT
PRINT ;
+1 NEW SDRRTODAY,SDRRCLIN,SDRRCLSAV,SDRRDT,SDRRREC,SDRRPAGE,SDRRABORT,SDRRDR,SDRRRP
+2 NEW SDRRPAT,SDRRSSN,SDRRCNT,SDRRDTX,SDRRPH,SDRRPW,SDRRSDT,SDRRDDAYS,SDRRPROV
+3 SET (SDRRABORT,SDRRPAGE)=0
+4 IF SDRRIA
WRITE @IOF
+5 SET SDRRTODAY=$$FMTE^XLFDT(DT)
+6 SET SDRRDR=$$CJ^XLFSTR(ZTDESC,IOM-1)
+7 SET $EXTRACT(SDRRDR,1,$LENGTH(SDRRTODAY))=SDRRTODAY
+8 SET SDRRDR=$EXTRACT(SDRRDR,1,IOM-8)_"Page"
+9 DO HEADER
+10 IF '$DATA(^TMP("SDRR",$JOB,"PRT"))
WRITE !,"No Recall Delinquencies found for this date range."
QUIT
+11 SET (SDRRCLIN,SDRRPAT,SDRRDDAYS)=""
+12 SET SDRRCLSAV=SDRRCLIN
+13 FOR
SET SDRRCLIN=$ORDER(^TMP("SDRR",$JOB,"PRT",SDRRCLIN))
if SDRRCLIN=""
QUIT
Begin DoDot:1
+14 IF SDRRCLSAV'=""
IF SDRRBRK!($Y+4+SDRRIA>IOSL)
Begin DoDot:2
+15 IF SDRRIA
DO PAGE^XMXUTIL(.SDRRABORT)
if SDRRABORT
QUIT
+16 WRITE @IOF
DO HEADER
End DoDot:2
if SDRRABORT
QUIT
+17 SET SDRRCLSAV=SDRRCLIN
+18 SET SDRRPROV=$$PRDEF^SDCO31($PIECE(SDRRCLIN,U,2))
+19 IF SDRRPROV=""
SET SDRRPROV="(No Default Provider)"
+20 WRITE !!,$$CJ^XLFSTR(" "_$PIECE(SDRRCLIN,U)_" "_SDRRPROV_" ",79,"-")
+21 SET SDRRCNT=0
+22 FOR
SET SDRRDDAYS=$ORDER(^TMP("SDRR",$JOB,"PRT",SDRRCLIN,SDRRDDAYS),-1)
if SDRRDDAYS=""
QUIT
Begin DoDot:2
+23 FOR
SET SDRRPAT=$ORDER(^TMP("SDRR",$JOB,"PRT",SDRRCLIN,SDRRDDAYS,SDRRPAT))
if SDRRPAT=""
QUIT
SET SDRRREC=^(SDRRPAT)
Begin DoDot:3
+24 SET SDRRCNT=SDRRCNT+1
+25 SET SDRRSSN=$EXTRACT(SDRRREC,1,4)
+26 SET SDRRPH=$PIECE(SDRRREC,U,2)
+27 SET SDRRPW=$PIECE(SDRRREC,U,3)
+28 SET SDRRDT=$PIECE(SDRRREC,U,4)
+29 SET SDRRRP=$PIECE(SDRRREC,U,5)
+30 SET SDRRSDT=$PIECE(SDRRREC,U,6)
+31 IF $Y+2+SDRRIA>IOSL
Begin DoDot:4
+32 IF SDRRIA
DO PAGE^XMXUTIL(.SDRRABORT)
if SDRRABORT
QUIT
+33 WRITE @IOF
DO HEADER
End DoDot:4
if SDRRABORT
QUIT
+34 WRITE !,$EXTRACT($PIECE(SDRRPAT,U),1,14),?15,SDRRSSN,?20,$EXTRACT(SDRRPH,1,18),?38,$EXTRACT(SDRRPW,1,20),?58,$$FMTE^XLFDT(SDRRDT,"2Z"),?66,$JUSTIFY(SDRRDDAYS,4),?71,SDRRRP_$$FMTE^XLFDT(SDRRSDT,"2Z")
End DoDot:3
if SDRRABORT
QUIT
End DoDot:2
if SDRRABORT
QUIT
+35 if SDRRABORT
QUIT
+36 DO SUBTOT
End DoDot:1
if SDRRABORT
QUIT
+37 if SDRRABORT
QUIT
+38 IF SDRRIA
DO WAIT^XMXUTIL
+39 QUIT
+1 SET SDRRPAGE=SDRRPAGE+1
+2 WRITE SDRRDR,$JUSTIFY(SDRRPAGE,3)
+3 WRITE !!,?71,"Reminder"
+4 WRITE !,"Patient",?15,"SSN",?20,"Home Phone",?38,"Work Phone",?58,"Recall",?66,"Days",?71,"Sent"
+5 QUIT
SUBTOT ;
+1 IF $Y+3+SDRRIA>IOSL
Begin DoDot:1
+2 IF SDRRIA
DO PAGE^XMXUTIL(.SDRRABORT)
if SDRRABORT
QUIT
+3 WRITE @IOF
DO HEADER
End DoDot:1
if SDRRABORT
QUIT
+4 WRITE !!,"Delinquent Patient Recalls: ",SDRRCNT
+5 QUIT
