SDRRISRA ;10N20/MAH;Recall Reminder Scheduled Report;01/18/2008
;;5.3;Scheduling;**536**;Aug 13, 1993;Build 53
; Option: SDRR RECALL APPOINTMENTS
EN ;
N ARHST,ARHND,ARHSTX,ARHNDX,ARHBRK,ARHABORT,I,ZTSAVE,XMDUZ,XMSUB,ZTSK
N ARHDIV,ARHDAYS,DIR,X,Y,Z,ZTDESC,ZTQUEUED
I '$D(^SD(403.56,"C")) W !!,"***No Entries Have Been Scheduled For Appointments***" Q
S ARHABORT=0
W !!,"Select a time period and a set of clinics, and I'll tell you all the"
W !,"patients who were on the Recall List, but were deleted from the list"
W !,"because they've made appointments."
W !!,"First select the Recall Date range. The default dates are determined by the"
W !,"entries in Recall Reminders Removed File."
S ARHST=$O(^SD(403.56,"C",""))
S ARHND=$O(^SD(403.56,"C",""),-1)
D DRANGE^SDRRUTL(.ARHST,.ARHND,.ARHSTX,.ARHNDX,.ARHABORT,ARHST,ARHND) Q:ARHABORT
K ^TMP("SDRR",$J)
D ASKDIV^SDRRPXC(.ARHDIV) Q:'ARHDIV
D ASKCLIN^SDRRPXC(.ARHDIV,ARHST,ARHND) 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 ARHBRK=Y ; Page break on Clinic
S XMSUB="Scheduled Recall Appointments, "_$S(ARHST=ARHND:ARHSTX,1:ARHSTX_"-"_ARHNDX)
F I="ARHDIV","ARHDIV(","ARHST","ARHSTX","ARHND","ARHNDX","ARHBRK","ARHDAYS","^TMP(""SDRR"",$J," S ZTSAVE(I)=""
D EN^XUTMDEVQ("CONTROL^SDRRISRA",XMSUB,.ZTSAVE,,1)
I '$D(ZTQUEUED),$D(ZTSK) W !,"Request queued. (Task: ",ZTSK,")"
Q
CONTROL ;
N ARHIA,ARHCLIST
S ARHIA=$E($G(IOST),1,2)="C-"
D CLINLIST^SDRRISB(.ARHCLIST)
D GATHER
D PRINT
K ^TMP("SDRR",$J)
Q
GATHER ; Gather Patient from Recall Deletions List
N ARHDT,ARHIEN,ARHDFN,ARHREC,ARHDFN0,ARHCLIN,ARHSDT,ARHADT,ARHADAYS,DFN,ARHMADE,ARHCOM
S ARHND=ARHND+.9999
S (ARHCLIN,ARHIEN)="" ; "D" xref is on Clinic and Recall Date
F S ARHCLIN=$O(ARHCLIST(ARHCLIN)) Q:'ARHCLIN D
. Q:'$D(^SD(403.56,"D",ARHCLIN))
. S ARHDT=ARHST-.1
. F S ARHDT=$O(^SD(403.56,"D",ARHCLIN,ARHDT)) Q:ARHDT>ARHND!'ARHDT D
. . F S ARHIEN=$O(^SD(403.56,"D",ARHCLIN,ARHDT,ARHIEN)) Q:'ARHIEN D
. . . S ARHADT=+$G(^SD(403.56,ARHIEN,1)) ; Appointment date
. . . Q:'ARHADT ; got appt.?
. . . S ARHREC=$G(^SD(403.56,ARHIEN,0))
. . . S ARHDFN=+ARHREC
. . . Q:$$TESTPAT^VADPT(ARHDFN) ; Test patient
. . . S DFN=ARHDFN
. . . D ADD^VADPT,DEM^VADPT
. . . Q:$G(VADM(6),U)'=""
. . . S ARHSDT=$P(ARHREC,U,10) ; Reminder sent date
. . . N SDARRAY,SDCOUNT,SDDATE,SDAPPT
. . . S SDARRAY(1)=""_$P(ARHADT,".",1)_";"_$P(ARHADT,".",1)_""
. . . S SDARRAY(2)=ARHCLIN
. . . S SDARRAY(4)=DFN
. . . S SDARRAY("FLDS")="16"
. . . S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
. . . I SDCOUNT>0 D
. . . . S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",DFN,ARHCLIN,SDDATE)) Q:SDDATE="" D
. . . . . S SDAPPT=$G(^TMP($J,"SDAMA301",DFN,ARHCLIN,SDDATE))
. . . . . S ARHMADE=$P(SDAPPT,"^",16)
. . . I SDCOUNT'=0 K ^TMP($J,"SDAMA301")
. . . S ARHADAYS=$$FMDIFF^XLFDT(ARHADT,ARHDT)
. . . S ARHCOM=$P($G(ARHREC),"^",7)
. . . S ^TMP("SDRR",$J,"PRT",ARHCLIST(ARHCLIN)_U_ARHCLIN,ARHADAYS,$P(VADM(1),U)_U_ARHDFN,ARHADT)=$P(VA("BID"),U)_U_ARHDT_U_ARHSDT_U_ARHMADE_U_ARHCOM
D KVAR^VADPT
Q
PRINT ;
N ARHTODAY,ARHCLIN,ARHCLSAV,ARHDT,ARHREC,ARHPAGE,ARHABORT,ARHDR,ARHADT,ARHSP
N ARHPAT,ARHSSN,ARHCNT,ARHDTX,ARHSDT,ARHADAYS,ARHPROV,ARHDFN,ARHOTHER,ARHCOMM
S (ARHABORT,ARHPAGE)=0
I ARHIA W @IOF
S ARHTODAY=$$FMTE^XLFDT(DT)
S ARHDR=$$CJ^XLFSTR(ZTDESC,IOM-1)
S $E(ARHDR,1,$L(ARHTODAY))=ARHTODAY
S ARHDR=$E(ARHDR,1,IOM-8)_"Page"
D HEADER
I '$D(^TMP("SDRR",$J,"PRT")) W !,"No Scheduled Recall Appointments found for this date range." Q
S (ARHCLIN,ARHPAT,ARHADAYS,ARHADT)=""
S ARHCLSAV=ARHCLIN
F S ARHCLIN=$O(^TMP("SDRR",$J,"PRT",ARHCLIN)) Q:ARHCLIN="" D Q:ARHABORT
. I ARHCLSAV'="",ARHBRK!($Y+5+ARHIA>IOSL) D Q:ARHABORT
. . I ARHIA D PAGE^XMXUTIL(.ARHABORT) Q:ARHABORT
. . W @IOF D HEADER
. S ARHCLSAV=ARHCLIN
. S ARHPROV=$$PRDEF^SDCO31($P(ARHCLIN,U,2))
. I ARHPROV="" S ARHPROV="(No Default Provider)"
. W !!,$$CJ^XLFSTR(" "_$P(ARHCLIN,U)_" "_ARHPROV_" ",79,"-")
. S ARHCNT=0
. F S ARHADAYS=$O(^TMP("SDRR",$J,"PRT",ARHCLIN,ARHADAYS),-1) Q:ARHADAYS="" D Q:ARHABORT
. . F S ARHPAT=$O(^TMP("SDRR",$J,"PRT",ARHCLIN,ARHADAYS,ARHPAT)) Q:ARHPAT="" D Q:ARHABORT
. . . S ARHDFN=$P(ARHPAT,U,2)
. . . F S ARHADT=$O(^TMP("SDRR",$J,"PRT",ARHCLIN,ARHADAYS,ARHPAT,ARHADT)) Q:'ARHADT S ARHREC=^(ARHADT) D Q:ARHABORT
. . . . S ARHCNT=ARHCNT+1
. . . . S ARHSSN=$E(ARHREC,1,4)
. . . . S ARHDT=$P(ARHREC,U,2)
. . . . S ARHSDT=$P(ARHREC,U,3)
. . . . S ARHMADE=$P(ARHREC,U,4)
. . . . S ARHCOMM=$P(ARHREC,U,5)
. . . . I $Y+2+($L(ARHCOMM)>18)+ARHIA>IOSL D Q:ARHABORT
. . . . . I ARHIA D PAGE^XMXUTIL(.ARHABORT) Q:ARHABORT
. . . . . W @IOF D HEADER
. . . . W !,$E($P(ARHPAT,U),1,14),?15,ARHSSN,?20,$$FMTE^XLFDT($E(ARHSDT,1,7),"2Z"),?29,$$FMTE^XLFDT($E(ARHDT,1,7),"2Z"),?38,$$FMTE^XLFDT($E(ARHADT,1,7),"2Z"),?47,$J(ARHADAYS,4)
. . . . W ?52,$$FMTE^XLFDT($E(ARHMADE,1,7),"2Z") I $L(ARHCOMM)<19 W ?61,ARHCOMM Q
. . . . Q:ARHCOMM=""
. . . . W !,$$RJ^XLFSTR($E(ARHCOMM,1,79),79)
. Q:ARHABORT
. D SUBTOT
Q:ARHABORT
I ARHIA D WAIT^XMXUTIL
Q
S ARHPAGE=ARHPAGE+1
W ARHDR,$J(ARHPAGE,3)
W !!,?20,"Reminder",?47,"Days",?52,"Appt"
W !,"Patient",?15,"SSN",?20,"Sent",?29,"Recall",?38,"Appt",?47,"Diff",?52,"Made",?61,"Other Info"
W !,"-------------- ---- -------- -------- -------- ---- -------- ------------------"
Q
SUBTOT ;
I $Y+3+ARHIA>IOSL D Q:ARHABORT
. I ARHIA D PAGE^XMXUTIL(.ARHABORT) Q:ARHABORT
. W @IOF D HEADER
W !!,"Scheduled Recall Appointments: ",ARHCNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRRISRA 5649 printed Nov 22, 2024@18:10:37 Page 2
SDRRISRA ;10N20/MAH;Recall Reminder Scheduled Report;01/18/2008
+1 ;;5.3;Scheduling;**536**;Aug 13, 1993;Build 53
+2 ; Option: SDRR RECALL APPOINTMENTS
EN ;
+1 NEW ARHST,ARHND,ARHSTX,ARHNDX,ARHBRK,ARHABORT,I,ZTSAVE,XMDUZ,XMSUB,ZTSK
+2 NEW ARHDIV,ARHDAYS,DIR,X,Y,Z,ZTDESC,ZTQUEUED
+3 IF '$DATA(^SD(403.56,"C"))
WRITE !!,"***No Entries Have Been Scheduled For Appointments***"
QUIT
+4 SET ARHABORT=0
+5 WRITE !!,"Select a time period and a set of clinics, and I'll tell you all the"
+6 WRITE !,"patients who were on the Recall List, but were deleted from the list"
+7 WRITE !,"because they've made appointments."
+8 WRITE !!,"First select the Recall Date range. The default dates are determined by the"
+9 WRITE !,"entries in Recall Reminders Removed File."
+10 SET ARHST=$ORDER(^SD(403.56,"C",""))
+11 SET ARHND=$ORDER(^SD(403.56,"C",""),-1)
+12 DO DRANGE^SDRRUTL(.ARHST,.ARHND,.ARHSTX,.ARHNDX,.ARHABORT,ARHST,ARHND)
if ARHABORT
QUIT
+13 KILL ^TMP("SDRR",$JOB)
+14 DO ASKDIV^SDRRPXC(.ARHDIV)
if 'ARHDIV
QUIT
+15 DO ASKCLIN^SDRRPXC(.ARHDIV,ARHST,ARHND)
if '$DATA(^TMP("SDRR",$JOB))
QUIT
+16 WRITE !
+17 KILL DIR,X,Y
+18 SET DIR(0)="Y"
+19 SET DIR("A")="Page break on clinic"
+20 SET DIR("B")="Yes"
+21 DO ^DIR
if $DATA(DIRUT)
QUIT
+22 KILL DIRUT
+23 ; Page break on Clinic
SET ARHBRK=Y
+24 SET XMSUB="Scheduled Recall Appointments, "_$SELECT(ARHST=ARHND:ARHSTX,1:ARHSTX_"-"_ARHNDX)
+25 FOR I="ARHDIV","ARHDIV(","ARHST","ARHSTX","ARHND","ARHNDX","ARHBRK","ARHDAYS","^TMP(""SDRR"",$J,"
SET ZTSAVE(I)=""
+26 DO EN^XUTMDEVQ("CONTROL^SDRRISRA",XMSUB,.ZTSAVE,,1)
+27 IF '$DATA(ZTQUEUED)
IF $DATA(ZTSK)
WRITE !,"Request queued. (Task: ",ZTSK,")"
+28 QUIT
CONTROL ;
+1 NEW ARHIA,ARHCLIST
+2 SET ARHIA=$EXTRACT($GET(IOST),1,2)="C-"
+3 DO CLINLIST^SDRRISB(.ARHCLIST)
+4 DO GATHER
+5 DO PRINT
+6 KILL ^TMP("SDRR",$JOB)
+7 QUIT
GATHER ; Gather Patient from Recall Deletions List
+1 NEW ARHDT,ARHIEN,ARHDFN,ARHREC,ARHDFN0,ARHCLIN,ARHSDT,ARHADT,ARHADAYS,DFN,ARHMADE,ARHCOM
+2 SET ARHND=ARHND+.9999
+3 ; "D" xref is on Clinic and Recall Date
SET (ARHCLIN,ARHIEN)=""
+4 FOR
SET ARHCLIN=$ORDER(ARHCLIST(ARHCLIN))
if 'ARHCLIN
QUIT
Begin DoDot:1
+5 if '$DATA(^SD(403.56,"D",ARHCLIN))
QUIT
+6 SET ARHDT=ARHST-.1
+7 FOR
SET ARHDT=$ORDER(^SD(403.56,"D",ARHCLIN,ARHDT))
if ARHDT>ARHND!'ARHDT
QUIT
Begin DoDot:2
+8 FOR
SET ARHIEN=$ORDER(^SD(403.56,"D",ARHCLIN,ARHDT,ARHIEN))
if 'ARHIEN
QUIT
Begin DoDot:3
+9 ; Appointment date
SET ARHADT=+$GET(^SD(403.56,ARHIEN,1))
+10 ; got appt.?
if 'ARHADT
QUIT
+11 SET ARHREC=$GET(^SD(403.56,ARHIEN,0))
+12 SET ARHDFN=+ARHREC
+13 ; Test patient
if $$TESTPAT^VADPT(ARHDFN)
QUIT
+14 SET DFN=ARHDFN
+15 DO ADD^VADPT
DO DEM^VADPT
+16 if $GET(VADM(6),U)'=""
QUIT
+17 ; Reminder sent date
SET ARHSDT=$PIECE(ARHREC,U,10)
+18 NEW SDARRAY,SDCOUNT,SDDATE,SDAPPT
+19 SET SDARRAY(1)=""_$PIECE(ARHADT,".",1)_";"_$PIECE(ARHADT,".",1)_""
+20 SET SDARRAY(2)=ARHCLIN
+21 SET SDARRAY(4)=DFN
+22 SET SDARRAY("FLDS")="16"
+23 SET SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
+24 IF SDCOUNT>0
Begin DoDot:4
+25 SET SDDATE=0
FOR
SET SDDATE=$ORDER(^TMP($JOB,"SDAMA301",DFN,ARHCLIN,SDDATE))
if SDDATE=""
QUIT
Begin DoDot:5
+26 SET SDAPPT=$GET(^TMP($JOB,"SDAMA301",DFN,ARHCLIN,SDDATE))
+27 SET ARHMADE=$PIECE(SDAPPT,"^",16)
End DoDot:5
End DoDot:4
+28 IF SDCOUNT'=0
KILL ^TMP($JOB,"SDAMA301")
+29 SET ARHADAYS=$$FMDIFF^XLFDT(ARHADT,ARHDT)
+30 SET ARHCOM=$PIECE($GET(ARHREC),"^",7)
+31 SET ^TMP("SDRR",$JOB,"PRT",ARHCLIST(ARHCLIN)_U_ARHCLIN,ARHADAYS,$PIECE(VADM(1),U)_U_ARHDFN,ARHADT)=$PIECE(VA("BID"),U)_U_ARHDT_U_ARHSDT_U_ARHMADE_U_ARHCOM
End DoDot:3
End DoDot:2
End DoDot:1
+32 DO KVAR^VADPT
+33 QUIT
PRINT ;
+1 NEW ARHTODAY,ARHCLIN,ARHCLSAV,ARHDT,ARHREC,ARHPAGE,ARHABORT,ARHDR,ARHADT,ARHSP
+2 NEW ARHPAT,ARHSSN,ARHCNT,ARHDTX,ARHSDT,ARHADAYS,ARHPROV,ARHDFN,ARHOTHER,ARHCOMM
+3 SET (ARHABORT,ARHPAGE)=0
+4 IF ARHIA
WRITE @IOF
+5 SET ARHTODAY=$$FMTE^XLFDT(DT)
+6 SET ARHDR=$$CJ^XLFSTR(ZTDESC,IOM-1)
+7 SET $EXTRACT(ARHDR,1,$LENGTH(ARHTODAY))=ARHTODAY
+8 SET ARHDR=$EXTRACT(ARHDR,1,IOM-8)_"Page"
+9 DO HEADER
+10 IF '$DATA(^TMP("SDRR",$JOB,"PRT"))
WRITE !,"No Scheduled Recall Appointments found for this date range."
QUIT
+11 SET (ARHCLIN,ARHPAT,ARHADAYS,ARHADT)=""
+12 SET ARHCLSAV=ARHCLIN
+13 FOR
SET ARHCLIN=$ORDER(^TMP("SDRR",$JOB,"PRT",ARHCLIN))
if ARHCLIN=""
QUIT
Begin DoDot:1
+14 IF ARHCLSAV'=""
IF ARHBRK!($Y+5+ARHIA>IOSL)
Begin DoDot:2
+15 IF ARHIA
DO PAGE^XMXUTIL(.ARHABORT)
if ARHABORT
QUIT
+16 WRITE @IOF
DO HEADER
End DoDot:2
if ARHABORT
QUIT
+17 SET ARHCLSAV=ARHCLIN
+18 SET ARHPROV=$$PRDEF^SDCO31($PIECE(ARHCLIN,U,2))
+19 IF ARHPROV=""
SET ARHPROV="(No Default Provider)"
+20 WRITE !!,$$CJ^XLFSTR(" "_$PIECE(ARHCLIN,U)_" "_ARHPROV_" ",79,"-")
+21 SET ARHCNT=0
+22 FOR
SET ARHADAYS=$ORDER(^TMP("SDRR",$JOB,"PRT",ARHCLIN,ARHADAYS),-1)
if ARHADAYS=""
QUIT
Begin DoDot:2
+23 FOR
SET ARHPAT=$ORDER(^TMP("SDRR",$JOB,"PRT",ARHCLIN,ARHADAYS,ARHPAT))
if ARHPAT=""
QUIT
Begin DoDot:3
+24 SET ARHDFN=$PIECE(ARHPAT,U,2)
+25 FOR
SET ARHADT=$ORDER(^TMP("SDRR",$JOB,"PRT",ARHCLIN,ARHADAYS,ARHPAT,ARHADT))
if 'ARHADT
QUIT
SET ARHREC=^(ARHADT)
Begin DoDot:4
+26 SET ARHCNT=ARHCNT+1
+27 SET ARHSSN=$EXTRACT(ARHREC,1,4)
+28 SET ARHDT=$PIECE(ARHREC,U,2)
+29 SET ARHSDT=$PIECE(ARHREC,U,3)
+30 SET ARHMADE=$PIECE(ARHREC,U,4)
+31 SET ARHCOMM=$PIECE(ARHREC,U,5)
+32 IF $Y+2+($LENGTH(ARHCOMM)>18)+ARHIA>IOSL
Begin DoDot:5
+33 IF ARHIA
DO PAGE^XMXUTIL(.ARHABORT)
if ARHABORT
QUIT
+34 WRITE @IOF
DO HEADER
End DoDot:5
if ARHABORT
QUIT
+35 WRITE !,$EXTRACT($PIECE(ARHPAT,U),1,14),?15,ARHSSN,?20,$$FMTE^XLFDT($EXTRACT(ARHSDT,1,7),"2Z"),?29,$$FMTE^XLFDT($EXTRACT(ARHDT,1,7),"2Z"),?38,$$FMTE^XLFDT($EXTRACT(ARHADT,1,7),"2Z"),?47,$JUSTIFY(ARHADAYS,4)
+36 WRITE ?52,$$FMTE^XLFDT($EXTRACT(ARHMADE,1,7),"2Z")
IF $LENGTH(ARHCOMM)<19
WRITE ?61,ARHCOMM
QUIT
+37 if ARHCOMM=""
QUIT
+38 WRITE !,$$RJ^XLFSTR($EXTRACT(ARHCOMM,1,79),79)
End DoDot:4
if ARHABORT
QUIT
End DoDot:3
if ARHABORT
QUIT
End DoDot:2
if ARHABORT
QUIT
+39 if ARHABORT
QUIT
+40 DO SUBTOT
End DoDot:1
if ARHABORT
QUIT
+41 if ARHABORT
QUIT
+42 IF ARHIA
DO WAIT^XMXUTIL
+43 QUIT
+1 SET ARHPAGE=ARHPAGE+1
+2 WRITE ARHDR,$JUSTIFY(ARHPAGE,3)
+3 WRITE !!,?20,"Reminder",?47,"Days",?52,"Appt"
+4 WRITE !,"Patient",?15,"SSN",?20,"Sent",?29,"Recall",?38,"Appt",?47,"Diff",?52,"Made",?61,"Other Info"
+5 WRITE !,"-------------- ---- -------- -------- -------- ---- -------- ------------------"
+6 QUIT
SUBTOT ;
+1 IF $Y+3+ARHIA>IOSL
Begin DoDot:1
+2 IF ARHIA
DO PAGE^XMXUTIL(.ARHABORT)
if ARHABORT
QUIT
+3 WRITE @IOF
DO HEADER
End DoDot:1
if ARHABORT
QUIT
+4 WRITE !!,"Scheduled Recall Appointments: ",ARHCNT
+5 QUIT
