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

SDRRISRD.m

Go to the documentation of this file. 
  1. SDRRISRD ;10N20/MAH;-Recall List Delinquencies ;01/18/2008  11:32
  1.  ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
  1.  ;
  1.  ; Option: SDRR RECALL DELINQUENCIES
  1. EN ;
  1.  N SDRRST,SDRRND,SDRRSTX,SDRRNDX,SDRRBRK,SDRRABORT,I,ZTSAVE,XMDUZ,XMSUB,ZTSK,VA,VADM,VAPA
  1.  N SDRRDIV,SDRRDAYS,DIR,X,Y,Z,ZTDESC,ZTQUEUED
  1.  S SDRRABORT=0
  1.  W !!,"Select a time period and a set of clinics, and I'll tell you all the"
  1.  W !,"patients who are on the Recall List for that time period at those clinics"
  1.  W !,"who've been sent reminders, but haven't yet made an appointment."
  1.  W !!,"First select the Recall Date range."
  1.  S SDRRND=$$FMADD^XLFDT(DT,-1)
  1.  D DRANGE^SDRRUTL(.SDRRST,.SDRRND,.SDRRSTX,.SDRRNDX,.SDRRABORT) Q:SDRRABORT
  1.  K ^TMP("SDRR",$J)
  1.  D ASKDIV^SDRRPXC(.SDRRDIV) Q:'SDRRDIV
  1.  D ASKCLIN^SDRRPXC(.SDRRDIV,SDRRST,SDRRND) 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 SDRRBRK=Y ; Page break on Clinic
  1.  S XMSUB="Recall Delinquency List, "_$S(SDRRST=SDRRND:SDRRSTX,1:SDRRSTX_"-"_SDRRNDX)
  1.  F I="SDRRDIV","SDRRDIV(","SDRRST","SDRRSTX","SDRRND","SDRRNDX","SDRRBRK","SDRRDAYS","^TMP(""SDRR"",$J," S ZTSAVE(I)=""
  1.  D EN^XUTMDEVQ("CONTROL^SDRRISRD",XMSUB,.ZTSAVE,,1)
  1.  I '$D(ZTQUEUED),$D(ZTSK) W !,"Request queued.  (Task: ",ZTSK,")"
  1.  Q
  1. CONTROL ;
  1.  N SDRRIA,SDRRCLIST
  1.  S SDRRIA=$E($G(IOST),1,2)="C-"
  1.  D CLINLIST^SDRRISB(.SDRRCLIST)
  1.  D GATHER
  1.  D PRINT
  1.  K ^TMP("SDRR",$J)
  1.  Q
  1. GATHER ; Gather Patient from Recall List
  1.  N SDRRDT,SDRRIEN,SDRRDFN,SDRRREC,SDRRDFN0,SDRRCLIN,SDRRSDT,SDRRPH,SDRRDDAYS,DFN,VA,VADM,VAPA
  1.  S SDRRND=SDRRND+.9999
  1.  S SDRRDT=SDRRST-.1
  1.  S SDRRIEN="" ; "D" xref is on the RECALL DATE field
  1.  F  S SDRRDT=$O(^SD(403.5,"D",SDRRDT)) Q:SDRRDT>SDRRND!'SDRRDT  D
  1.  . F  S SDRRIEN=$O(^SD(403.5,"D",SDRRDT,SDRRIEN)) Q:'SDRRIEN  D
  1.  . . S SDRRREC=$G(^SD(403.5,SDRRIEN,0))
  1.  . . S SDRRCLIN=+$P(SDRRREC,U,2)
  1.  . . Q:'$D(SDRRCLIST(SDRRCLIN))  ; Must be clinic we want
  1.  . . S SDRRSDT=$P(SDRRREC,U,10) ; Reminder sent date
  1.  . . S Z=$P(SDRRREC,U,13) I Z'="" S Z="*"
  1.  . . Q:'SDRRSDT  ; Reminder must have been sent
  1.  . . S SDRRDFN=+SDRRREC
  1.  . . Q:$$TESTPAT^VADPT(SDRRDFN)  ; Test patient
  1.  . . S DFN=SDRRDFN
  1.  . . D ADD^VADPT,DEM^VADPT
  1.  . . Q:$G(VADM(6),U)'=""
  1.  . . S SDRRDDAYS=$$FMDIFF^XLFDT(DT,SDRRDT)
  1.  . . N SDRRPW
  1.  . . S SDRRPW="" S SDRRPW=$$GET1^DIQ(2,DFN_",",.132)
  1.  . . 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
  1.  D KVAR^VADPT
  1.  Q
  1. PRINT ;
  1.  N SDRRTODAY,SDRRCLIN,SDRRCLSAV,SDRRDT,SDRRREC,SDRRPAGE,SDRRABORT,SDRRDR,SDRRRP
  1.  N SDRRPAT,SDRRSSN,SDRRCNT,SDRRDTX,SDRRPH,SDRRPW,SDRRSDT,SDRRDDAYS,SDRRPROV
  1.  S (SDRRABORT,SDRRPAGE)=0
  1.  I SDRRIA W @IOF
  1.  S SDRRTODAY=$$FMTE^XLFDT(DT)
  1.  S SDRRDR=$$CJ^XLFSTR(ZTDESC,IOM-1)
  1.  S $E(SDRRDR,1,$L(SDRRTODAY))=SDRRTODAY
  1.  S SDRRDR=$E(SDRRDR,1,IOM-8)_"Page"
  1.  D HEADER
  1.  I '$D(^TMP("SDRR",$J,"PRT")) W !,"No Recall Delinquencies found for this date range." Q
  1.  S (SDRRCLIN,SDRRPAT,SDRRDDAYS)=""
  1.  S SDRRCLSAV=SDRRCLIN
  1.  F  S SDRRCLIN=$O(^TMP("SDRR",$J,"PRT",SDRRCLIN)) Q:SDRRCLIN=""  D  Q:SDRRABORT
  1.  . I SDRRCLSAV'="",SDRRBRK!($Y+4+SDRRIA>IOSL) D  Q:SDRRABORT
  1.  . . I SDRRIA D PAGE^XMXUTIL(.SDRRABORT) Q:SDRRABORT
  1.  . . W @IOF D HEADER
  1.  . S SDRRCLSAV=SDRRCLIN
  1.  . S SDRRPROV=$$PRDEF^SDCO31($P(SDRRCLIN,U,2))
  1.  . I SDRRPROV="" S SDRRPROV="(No Default Provider)"
  1.  . W !!,$$CJ^XLFSTR(" "_$P(SDRRCLIN,U)_"    "_SDRRPROV_" ",79,"-")
  1.  . S SDRRCNT=0
  1.  . F  S SDRRDDAYS=$O(^TMP("SDRR",$J,"PRT",SDRRCLIN,SDRRDDAYS),-1) Q:SDRRDDAYS=""  D  Q:SDRRABORT
  1.  . . F  S SDRRPAT=$O(^TMP("SDRR",$J,"PRT",SDRRCLIN,SDRRDDAYS,SDRRPAT)) Q:SDRRPAT=""  S SDRRREC=^(SDRRPAT) D  Q:SDRRABORT
  1.  . . . S SDRRCNT=SDRRCNT+1
  1.  . . . S SDRRSSN=$E(SDRRREC,1,4)
  1.  . . . S SDRRPH=$P(SDRRREC,U,2)
  1.  . . . S SDRRPW=$P(SDRRREC,U,3)
  1.  . . . S SDRRDT=$P(SDRRREC,U,4)
  1.  . . . S SDRRRP=$P(SDRRREC,U,5)
  1.  . . . S SDRRSDT=$P(SDRRREC,U,6)
  1.  . . . I $Y+2+SDRRIA>IOSL D  Q:SDRRABORT
  1.  . . . . I SDRRIA D PAGE^XMXUTIL(.SDRRABORT) Q:SDRRABORT
  1.  . . . . W @IOF D HEADER
  1.  . . . 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")
  1.  . Q:SDRRABORT
  1.  . D SUBTOT
  1.  Q:SDRRABORT
  1.  I SDRRIA D WAIT^XMXUTIL
  1.  Q
  1.  S SDRRPAGE=SDRRPAGE+1
  1.  W SDRRDR,$J(SDRRPAGE,3)
  1.  W !!,?71,"Reminder"
  1.  W !,"Patient",?15,"SSN",?20,"Home Phone",?38,"Work Phone",?58,"Recall",?66,"Days",?71,"Sent"
  1.  Q
  1. SUBTOT ;
  1.  I $Y+3+SDRRIA>IOSL D  Q:SDRRABORT
  1.  . I SDRRIA D PAGE^XMXUTIL(.SDRRABORT) Q:SDRRABORT
  1.  . W @IOF D HEADER
  1.  W !!,"Delinquent Patient Recalls: ",SDRRCNT
  1.  Q