- SDRRISRA ;10N20/MAH;Recall Reminder Scheduled Report;01/18/2008
- ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
- ; 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
- SDRRISRA ;10N20/MAH;Recall Reminder Scheduled Report;01/18/2008
- +1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
- +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
