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