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