Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDRRISRA

SDRRISRA.m

Go to the documentation of this file.
  1. SDRRISRA ;10N20/MAH;Recall Reminder Scheduled Report;01/18/2008
  1. ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
  1. ; Option: SDRR RECALL APPOINTMENTS
  1. EN ;
  1. N ARHST,ARHND,ARHSTX,ARHNDX,ARHBRK,ARHABORT,I,ZTSAVE,XMDUZ,XMSUB,ZTSK
  1. N ARHDIV,ARHDAYS,DIR,X,Y,Z,ZTDESC,ZTQUEUED
  1. I '$D(^SD(403.56,"C")) W !!,"***No Entries Have Been Scheduled For Appointments***" Q
  1. S ARHABORT=0
  1. W !!,"Select a time period and a set of clinics, and I'll tell you all the"
  1. W !,"patients who were on the Recall List, but were deleted from the list"
  1. W !,"because they've made appointments."
  1. W !!,"First select the Recall Date range. The default dates are determined by the"
  1. W !,"entries in Recall Reminders Removed File."
  1. S ARHST=$O(^SD(403.56,"C",""))
  1. S ARHND=$O(^SD(403.56,"C",""),-1)
  1. D DRANGE^SDRRUTL(.ARHST,.ARHND,.ARHSTX,.ARHNDX,.ARHABORT,ARHST,ARHND) Q:ARHABORT
  1. K ^TMP("SDRR",$J)
  1. D ASKDIV^SDRRPXC(.ARHDIV) Q:'ARHDIV
  1. D ASKCLIN^SDRRPXC(.ARHDIV,ARHST,ARHND) Q:'$D(^TMP("SDRR",$J))
  1. W !
  1. K DIR,X,Y
  1. S DIR(0)="Y"
  1. S DIR("A")="Page break on clinic"
  1. S DIR("B")="Yes"
  1. D ^DIR Q:$D(DIRUT)
  1. K DIRUT
  1. S ARHBRK=Y ; Page break on Clinic
  1. S XMSUB="Scheduled Recall Appointments, "_$S(ARHST=ARHND:ARHSTX,1:ARHSTX_"-"_ARHNDX)
  1. F I="ARHDIV","ARHDIV(","ARHST","ARHSTX","ARHND","ARHNDX","ARHBRK","ARHDAYS","^TMP(""SDRR"",$J," S ZTSAVE(I)=""
  1. D EN^XUTMDEVQ("CONTROL^SDRRISRA",XMSUB,.ZTSAVE,,1)
  1. I '$D(ZTQUEUED),$D(ZTSK) W !,"Request queued. (Task: ",ZTSK,")"
  1. Q
  1. CONTROL ;
  1. N ARHIA,ARHCLIST
  1. S ARHIA=$E($G(IOST),1,2)="C-"
  1. D CLINLIST^SDRRISB(.ARHCLIST)
  1. D GATHER
  1. D PRINT
  1. K ^TMP("SDRR",$J)
  1. Q
  1. GATHER ; Gather Patient from Recall Deletions List
  1. N ARHDT,ARHIEN,ARHDFN,ARHREC,ARHDFN0,ARHCLIN,ARHSDT,ARHADT,ARHADAYS,DFN,ARHMADE,ARHCOM
  1. S ARHND=ARHND+.9999
  1. S (ARHCLIN,ARHIEN)="" ; "D" xref is on Clinic and Recall Date
  1. F S ARHCLIN=$O(ARHCLIST(ARHCLIN)) Q:'ARHCLIN D
  1. . Q:'$D(^SD(403.56,"D",ARHCLIN))
  1. . S ARHDT=ARHST-.1
  1. . F S ARHDT=$O(^SD(403.56,"D",ARHCLIN,ARHDT)) Q:ARHDT>ARHND!'ARHDT D
  1. . . F S ARHIEN=$O(^SD(403.56,"D",ARHCLIN,ARHDT,ARHIEN)) Q:'ARHIEN D
  1. . . . S ARHADT=+$G(^SD(403.56,ARHIEN,1)) ; Appointment date
  1. . . . Q:'ARHADT ; got appt.?
  1. . . . S ARHREC=$G(^SD(403.56,ARHIEN,0))
  1. . . . S ARHDFN=+ARHREC
  1. . . . Q:$$TESTPAT^VADPT(ARHDFN) ; Test patient
  1. . . . S DFN=ARHDFN
  1. . . . D ADD^VADPT,DEM^VADPT
  1. . . . Q:$G(VADM(6),U)'=""
  1. . . . S ARHSDT=$P(ARHREC,U,10) ; Reminder sent date
  1. . . . N SDARRAY,SDCOUNT,SDDATE,SDAPPT
  1. . . . S SDARRAY(1)=""_$P(ARHADT,".",1)_";"_$P(ARHADT,".",1)_""
  1. . . . S SDARRAY(2)=ARHCLIN
  1. . . . S SDARRAY(4)=DFN
  1. . . . S SDARRAY("FLDS")="16"
  1. . . . S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
  1. . . . I SDCOUNT>0 D
  1. . . . . S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",DFN,ARHCLIN,SDDATE)) Q:SDDATE="" D
  1. . . . . . S SDAPPT=$G(^TMP($J,"SDAMA301",DFN,ARHCLIN,SDDATE))
  1. . . . . . S ARHMADE=$P(SDAPPT,"^",16)
  1. . . . I SDCOUNT'=0 K ^TMP($J,"SDAMA301")
  1. . . . S ARHADAYS=$$FMDIFF^XLFDT(ARHADT,ARHDT)
  1. . . . S ARHCOM=$P($G(ARHREC),"^",7)
  1. . . . 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
  1. D KVAR^VADPT
  1. Q
  1. PRINT ;
  1. N ARHTODAY,ARHCLIN,ARHCLSAV,ARHDT,ARHREC,ARHPAGE,ARHABORT,ARHDR,ARHADT,ARHSP
  1. N ARHPAT,ARHSSN,ARHCNT,ARHDTX,ARHSDT,ARHADAYS,ARHPROV,ARHDFN,ARHOTHER,ARHCOMM
  1. S (ARHABORT,ARHPAGE)=0
  1. I ARHIA W @IOF
  1. S ARHTODAY=$$FMTE^XLFDT(DT)
  1. S ARHDR=$$CJ^XLFSTR(ZTDESC,IOM-1)
  1. S $E(ARHDR,1,$L(ARHTODAY))=ARHTODAY
  1. S ARHDR=$E(ARHDR,1,IOM-8)_"Page"
  1. D HEADER
  1. I '$D(^TMP("SDRR",$J,"PRT")) W !,"No Scheduled Recall Appointments found for this date range." Q
  1. S (ARHCLIN,ARHPAT,ARHADAYS,ARHADT)=""
  1. S ARHCLSAV=ARHCLIN
  1. F S ARHCLIN=$O(^TMP("SDRR",$J,"PRT",ARHCLIN)) Q:ARHCLIN="" D Q:ARHABORT
  1. . I ARHCLSAV'="",ARHBRK!($Y+5+ARHIA>IOSL) D Q:ARHABORT
  1. . . I ARHIA D PAGE^XMXUTIL(.ARHABORT) Q:ARHABORT
  1. . . W @IOF D HEADER
  1. . S ARHCLSAV=ARHCLIN
  1. . S ARHPROV=$$PRDEF^SDCO31($P(ARHCLIN,U,2))
  1. . I ARHPROV="" S ARHPROV="(No Default Provider)"
  1. . W !!,$$CJ^XLFSTR(" "_$P(ARHCLIN,U)_" "_ARHPROV_" ",79,"-")
  1. . S ARHCNT=0
  1. . F S ARHADAYS=$O(^TMP("SDRR",$J,"PRT",ARHCLIN,ARHADAYS),-1) Q:ARHADAYS="" D Q:ARHABORT
  1. . . F S ARHPAT=$O(^TMP("SDRR",$J,"PRT",ARHCLIN,ARHADAYS,ARHPAT)) Q:ARHPAT="" D Q:ARHABORT
  1. . . . S ARHDFN=$P(ARHPAT,U,2)
  1. . . . F S ARHADT=$O(^TMP("SDRR",$J,"PRT",ARHCLIN,ARHADAYS,ARHPAT,ARHADT)) Q:'ARHADT S ARHREC=^(ARHADT) D Q:ARHABORT
  1. . . . . S ARHCNT=ARHCNT+1
  1. . . . . S ARHSSN=$E(ARHREC,1,4)
  1. . . . . S ARHDT=$P(ARHREC,U,2)
  1. . . . . S ARHSDT=$P(ARHREC,U,3)
  1. . . . . S ARHMADE=$P(ARHREC,U,4)
  1. . . . . S ARHCOMM=$P(ARHREC,U,5)
  1. . . . . I $Y+2+($L(ARHCOMM)>18)+ARHIA>IOSL D Q:ARHABORT
  1. . . . . . I ARHIA D PAGE^XMXUTIL(.ARHABORT) Q:ARHABORT
  1. . . . . . W @IOF D HEADER
  1. . . . . 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)
  1. . . . . W ?52,$$FMTE^XLFDT($E(ARHMADE,1,7),"2Z") I $L(ARHCOMM)<19 W ?61,ARHCOMM Q
  1. . . . . Q:ARHCOMM=""
  1. . . . . W !,$$RJ^XLFSTR($E(ARHCOMM,1,79),79)
  1. . Q:ARHABORT
  1. . D SUBTOT
  1. Q:ARHABORT
  1. I ARHIA D WAIT^XMXUTIL
  1. Q
  1. S ARHPAGE=ARHPAGE+1
  1. W ARHDR,$J(ARHPAGE,3)
  1. W !!,?20,"Reminder",?47,"Days",?52,"Appt"
  1. W !,"Patient",?15,"SSN",?20,"Sent",?29,"Recall",?38,"Appt",?47,"Diff",?52,"Made",?61,"Other Info"
  1. W !,"-------------- ---- -------- -------- -------- ---- -------- ------------------"
  1. Q
  1. SUBTOT ;
  1. I $Y+3+ARHIA>IOSL D Q:ARHABORT
  1. . I ARHIA D PAGE^XMXUTIL(.ARHABORT) Q:ARHABORT
  1. . W @IOF D HEADER
  1. W !!,"Scheduled Recall Appointments: ",ARHCNT
  1. Q