SDRRISRL ;10N20/MAH;Recall Reminder Open Slots Report;01/18/2008
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
; Option: SDRR RECALL LIST
EN ;
N SDRRST,SDRRND,SDRRSTX,SDRRNDX,SDRRBRK,SDRRABORT,DIRUT,I,ZTSAVE,XMDUZ,XMSUB,ZTQUEUED,ZTSK
N SDRRDIV,ZTDESC
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 !,"For each month, I'll also tell you how many slots are available in each clinic.",!
W !,"First select the Recall Date range."
S SDRRST=$E(DT,1,5)_"01" ; 1st of this month
I $E(DT,4,5)>27 S SDRRST=$E($$FMADD^XLFDT(SDRRST,31),1,5)_"01" ; 1st of next month
S SDRRND=$E($$SCH^XLFDT("3M",SDRRST),1,7) ; 3 months later
D DRANGE^SDRRUTL(.SDRRST,.SDRRND,.SDRRSTX,.SDRRNDX,.SDRRABORT,SDRRST,$$FMADD^XLFDT(DT,366),1) Q:SDRRABORT
K ^TMP("SDRR",$J)
D ASKDIV^SDRRPXC(.SDRRDIV) Q:'SDRRDIV
D ASKCLIN^SDRRPXC(.SDRRDIV,SDRRST,SDRRND) Q:'$D(^TMP("SDRR",$J))
W !
N DIR,X,Y
S DIR(0)="Y"
S DIR("A")="Page break on clinic"
S DIR("B")="Yes"
D ^DIR Q:$D(DIRUT)
S SDRRBRK=Y ; Page break on Clinic
S XMSUB="Future Recall Slots, "_$S(SDRRST=SDRRND:SDRRSTX,1:SDRRSTX_"-"_SDRRNDX)
F I="SDRRDIV","SDRRDIV(","SDRRST","SDRRSTX","SDRRND","SDRRNDX","SDRRBRK","^TMP(""SDRR"",$J," S ZTSAVE(I)=""
D EN^XUTMDEVQ("CONTROL^SDRRISRL",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,SDRRCLERK,SDRRSDT,SDRRPHONE,DFN,VA,VADM,VAPA,Z
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 SDRRDFN=+SDRRREC
. . Q:$$TESTPAT^VADPT(SDRRDFN) ; Test patient
. . S SDRRSDT=$P(SDRRREC,U,10) ; Reminder sent date
. . S SDRRCLERK=+$P(SDRRREC,U,11) ; Clerk who entered the recall
. . S Z=$P(SDRRREC,U,13) I Z'="" S Z="*"
. . S DFN=SDRRDFN
. . D ADD^VADPT,DEM^VADPT
. . S ^TMP("SDRR",$J,"PRT",SDRRCLIST(SDRRCLIN)_U_SDRRCLIN,SDRRDT,$P(VADM(1),U)_U_SDRRDFN)=$P(VA("BID"),U)_U_$P(VAPA(8),U)_U_SDRRCLERK_U_SDRRSDT_U_Z
D KVAR^VADPT
Q
PRINT ;
N SDRRTODAY,SDRRCLIN,SDRRCLSAV,SDRRDT,SDRRDTSAV,SDRRREC,SDRRPAGE,SDRRABORT,SDRRDR,SDRRRP
N SDRRCLERK,SDRRPAT,SDRRSSN,SDRRCNT,SDRRDTX,SDRRPHONE,SDRRSDT,SDRRMDT,SDRRMDTX
N SDRRPROV
S SDRRMDT=$$FMADD^XLFDT(DT,1) ; earliest date to look for slot availability
S SDRRMDTX=$$FMTE^XLFDT(SDRRMDT,"2Z")
S (SDRRABORT,SDRRPAGE,SDRRCNT)=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 Recalls found for this date range." Q
S (SDRRCLIN,SDRRDT,SDRRPAT)=""
S SDRRCLSAV=SDRRCLIN
F S SDRRCLIN=$O(^TMP("SDRR",$J,"PRT",SDRRCLIN)) Q:SDRRCLIN="" D Q:SDRRABORT
. I SDRRCLSAV'="",SDRRBRK!($Y+5+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 SDRRDTSAV=SDRRDT
. F S SDRRDT=$O(^TMP("SDRR",$J,"PRT",SDRRCLIN,SDRRDT)) Q:'SDRRDT D Q:SDRRABORT
. . S SDRRDTX=$$FMTE^XLFDT(SDRRDT,"2Z")
. . I SDRRDTSAV'=$E(SDRRDT,1,5) D Q:SDRRABORT
. . . I SDRRDTSAV D SUBTOT
. . . S SDRRCNT=0
. . . S SDRRDTSAV=$E(SDRRDT,1,5)
. . . I $Y+2+SDRRIA>IOSL D Q:SDRRABORT
. . . . I SDRRIA D PAGE^XMXUTIL(.SDRRABORT) Q:SDRRABORT
. . . . W @IOF D HEADER
. . . W !
. . F S SDRRPAT=$O(^TMP("SDRR",$J,"PRT",SDRRCLIN,SDRRDT,SDRRPAT)) Q:SDRRPAT="" S SDRRREC=^(SDRRPAT) D Q:SDRRABORT
. . . S SDRRCNT=SDRRCNT+1
. . . S SDRRSSN=$E(SDRRREC,1,4)
. . . S SDRRPHONE=$P(SDRRREC,U,2)
. . . S SDRRCLERK=$P(SDRRREC,U,3) S SDRRCLERK=$$NAME^XUSER(SDRRCLERK,"F")
. . . S SDRRSDT=$P(SDRRREC,U,4)
. . . S SDRRRP=$P(SDRRREC,U,5)
. . . I $Y+2+SDRRIA>IOSL D Q:SDRRABORT
. . . . I SDRRIA D PAGE^XMXUTIL(.SDRRABORT) Q:SDRRABORT
. . . . W @IOF D HEADER
. . . W !,SDRRDTX,?10,SDRRRP_$$FMTE^XLFDT(SDRRSDT,"2Z"),?20,$E($P(SDRRPAT,U),1,17),?38,SDRRSSN,?43,SDRRPHONE,?64,$E(SDRRCLERK,1,15)
. Q:SDRRABORT
. D SUBTOT
Q:SDRRABORT
I SDRRIA D WAIT^XMXUTIL
Q
S SDRRPAGE=SDRRPAGE+1
W SDRRDR,$J(SDRRPAGE,3)
W !!,?10,"Reminder",?64,"Recall"
W !,"Recall",?10,"Sent",?20,"Patient",?38,"SSN",?43,"Home Phone",?64,"Entered by"
Q
SUBTOT ;
I $Y+3+SDRRIA>IOSL D Q:SDRRABORT
. I SDRRIA D PAGE^XMXUTIL(.SDRRABORT) Q:SDRRABORT
. W @IOF D HEADER
W !!,$$FMTE^XLFDT(SDRRDTSAV_"00",1)," Patient Recalls: ",SDRRCNT,", Available Slots: ",$$OPENSLOT^SDRRISRU($P(SDRRCLIN,U,2),$S(SDRRDTSAV=$E(SDRRMDT,1,5):SDRRMDT,1:SDRRDTSAV_"01"))
I SDRRDTSAV=$E(SDRRMDT,1,5) W " (",SDRRMDTX," through EOM)"
Q
SDRRISRL ;10N20/MAH;Recall Reminder Open Slots Report;01/18/2008
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
+2 ; Option: SDRR RECALL LIST
EN ;
+1 NEW SDRRST,SDRRND,SDRRSTX,SDRRNDX,SDRRBRK,SDRRABORT,DIRUT,I,ZTSAVE,XMDUZ,XMSUB,ZTQUEUED,ZTSK
+2 NEW SDRRDIV,ZTDESC
+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 !,"For each month, I'll also tell you how many slots are available in each clinic.",!
+7 WRITE !,"First select the Recall Date range."
+8 ; 1st of this month
SET SDRRST=$EXTRACT(DT,1,5)_"01"
+9 ; 1st of next month
IF $EXTRACT(DT,4,5)>27
SET SDRRST=$EXTRACT($$FMADD^XLFDT(SDRRST,31),1,5)_"01"
+10 ; 3 months later
SET SDRRND=$EXTRACT($$SCH^XLFDT("3M",SDRRST),1,7)
+11 DO DRANGE^SDRRUTL(.SDRRST,.SDRRND,.SDRRSTX,.SDRRNDX,.SDRRABORT,SDRRST,$$FMADD^XLFDT(DT,366),1)
IF SDRRABORT
QUIT
+12 KILL ^TMP("SDRR",$JOB)
+13 DO ASKDIV^SDRRPXC(.SDRRDIV)
IF 'SDRRDIV
QUIT
+14 DO ASKCLIN^SDRRPXC(.SDRRDIV,SDRRST,SDRRND)
IF '$DATA(^TMP("SDRR",$JOB))
QUIT
+15 WRITE !
+16 NEW DIR,X,Y
+17 SET DIR(0)="Y"
+18 SET DIR("A")="Page break on clinic"
+19 SET DIR("B")="Yes"
+20 DO ^DIR
IF $DATA(DIRUT)
QUIT
+21 ; Page break on Clinic
SET SDRRBRK=Y
+22 SET XMSUB="Future Recall Slots, "_$SELECT(SDRRST=SDRRND:SDRRSTX,1:SDRRSTX_"-"_SDRRNDX)
+23 FOR I="SDRRDIV","SDRRDIV(","SDRRST","SDRRSTX","SDRRND","SDRRNDX","SDRRBRK","^TMP(""SDRR"",$J,"
SET ZTSAVE(I)=""
+24 DO EN^XUTMDEVQ("CONTROL^SDRRISRL",XMSUB,.ZTSAVE,,1)
+25 IF '$DATA(ZTQUEUED)
IF $DATA(ZTSK)
WRITE !,"Request queued. (Task: ",ZTSK,")"
+26 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,SDRRCLERK,SDRRSDT,SDRRPHONE,DFN,VA,VADM,VAPA,Z
+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 SET SDRRDFN=+SDRRREC
+11 ; Test patient
IF $$TESTPAT^VADPT(SDRRDFN)
QUIT
+12 ; Reminder sent date
SET SDRRSDT=$PIECE(SDRRREC,U,10)
+13 ; Clerk who entered the recall
SET SDRRCLERK=+$PIECE(SDRRREC,U,11)
+14 SET Z=$PIECE(SDRRREC,U,13)
IF Z'=""
SET Z="*"
+15 SET DFN=SDRRDFN
+16 DO ADD^VADPT
DO DEM^VADPT
+17 SET ^TMP("SDRR",$JOB,"PRT",SDRRCLIST(SDRRCLIN)_U_SDRRCLIN,SDRRDT,$PIECE(VADM(1),U)_U_SDRRDFN)=$PIECE(VA("BID"),U)_U_$PIECE(VAPA(8),U)_U_SDRRCLERK_U_SDRRSDT_U_Z
End DoDot:2
End DoDot:1
+18 DO KVAR^VADPT
+19 QUIT
PRINT ;
+1 NEW SDRRTODAY,SDRRCLIN,SDRRCLSAV,SDRRDT,SDRRDTSAV,SDRRREC,SDRRPAGE,SDRRABORT,SDRRDR,SDRRRP
+2 NEW SDRRCLERK,SDRRPAT,SDRRSSN,SDRRCNT,SDRRDTX,SDRRPHONE,SDRRSDT,SDRRMDT,SDRRMDTX
+3 NEW SDRRPROV
+4 ; earliest date to look for slot availability
SET SDRRMDT=$$FMADD^XLFDT(DT,1)
+5 SET SDRRMDTX=$$FMTE^XLFDT(SDRRMDT,"2Z")
+6 SET (SDRRABORT,SDRRPAGE,SDRRCNT)=0
+7 IF SDRRIA
WRITE @IOF
+8 SET SDRRTODAY=$$FMTE^XLFDT(DT)
+9 SET SDRRDR=$$CJ^XLFSTR(ZTDESC,IOM-1)
+10 SET $EXTRACT(SDRRDR,1,$LENGTH(SDRRTODAY))=SDRRTODAY
+11 SET SDRRDR=$EXTRACT(SDRRDR,1,IOM-8)_"Page"
+12 DO HEADER
+13 IF '$DATA(^TMP("SDRR",$JOB,"PRT"))
WRITE !,"No Recalls found for this date range."
QUIT
+14 SET (SDRRCLIN,SDRRDT,SDRRPAT)=""
+15 SET SDRRCLSAV=SDRRCLIN
+16 FOR
SET SDRRCLIN=$ORDER(^TMP("SDRR",$JOB,"PRT",SDRRCLIN))
IF SDRRCLIN=""
QUIT
Begin DoDot:1
+17 IF SDRRCLSAV'=""
IF SDRRBRK!($Y+5+SDRRIA>IOSL)
Begin DoDot:2
+18 IF SDRRIA
DO PAGE^XMXUTIL(.SDRRABORT)
IF SDRRABORT
QUIT
+19 WRITE @IOF
DO HEADER
End DoDot:2
IF SDRRABORT
QUIT
+20 SET SDRRCLSAV=SDRRCLIN
+21 SET SDRRPROV=$$PRDEF^SDCO31($PIECE(SDRRCLIN,U,2))
+22 IF SDRRPROV=""
SET SDRRPROV="(No Default Provider)"
+23 WRITE !!,$$CJ^XLFSTR(" "_$PIECE(SDRRCLIN,U)_" "_SDRRPROV_" ",79,"-")
+24 SET SDRRDTSAV=SDRRDT
+25 FOR
SET SDRRDT=$ORDER(^TMP("SDRR",$JOB,"PRT",SDRRCLIN,SDRRDT))
IF 'SDRRDT
QUIT
Begin DoDot:2
+26 SET SDRRDTX=$$FMTE^XLFDT(SDRRDT,"2Z")
+27 IF SDRRDTSAV'=$EXTRACT(SDRRDT,1,5)
Begin DoDot:3
+28 IF SDRRDTSAV
DO SUBTOT
+29 SET SDRRCNT=0
+30 SET SDRRDTSAV=$EXTRACT(SDRRDT,1,5)
+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 !
End DoDot:3
IF SDRRABORT
QUIT
+35 FOR
SET SDRRPAT=$ORDER(^TMP("SDRR",$JOB,"PRT",SDRRCLIN,SDRRDT,SDRRPAT))
IF SDRRPAT=""
QUIT
SET SDRRREC=^(SDRRPAT)
Begin DoDot:3
+36 SET SDRRCNT=SDRRCNT+1
+37 SET SDRRSSN=$EXTRACT(SDRRREC,1,4)
+38 SET SDRRPHONE=$PIECE(SDRRREC,U,2)
+39 SET SDRRCLERK=$PIECE(SDRRREC,U,3)
SET SDRRCLERK=$$NAME^XUSER(SDRRCLERK,"F")
+40 SET SDRRSDT=$PIECE(SDRRREC,U,4)
+41 SET SDRRRP=$PIECE(SDRRREC,U,5)
+42 IF $Y+2+SDRRIA>IOSL
Begin DoDot:4
+43 IF SDRRIA
DO PAGE^XMXUTIL(.SDRRABORT)
IF SDRRABORT
QUIT
+44 WRITE @IOF
DO HEADER
End DoDot:4
IF SDRRABORT
QUIT
+45 WRITE !,SDRRDTX,?10,SDRRRP_$$FMTE^XLFDT(SDRRSDT,"2Z"),?20,$EXTRACT($PIECE(SDRRPAT,U),1,17),?38,SDRRSSN,?43,SDRRPHONE,?64,$EXTRACT(SDRRCLERK,1,15)
End DoDot:3
IF SDRRABORT
QUIT
End DoDot:2
IF SDRRABORT
QUIT
+46 IF SDRRABORT
QUIT
+47 DO SUBTOT
End DoDot:1
IF SDRRABORT
QUIT
+48 IF SDRRABORT
QUIT
+49 IF SDRRIA
DO WAIT^XMXUTIL
+50 QUIT
+1 SET SDRRPAGE=SDRRPAGE+1
+2 WRITE SDRRDR,$JUSTIFY(SDRRPAGE,3)
+3 WRITE !!,?10,"Reminder",?64,"Recall"
+4 WRITE !,"Recall",?10,"Sent",?20,"Patient",?38,"SSN",?43,"Home Phone",?64,"Entered by"
+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 !!,$$FMTE^XLFDT(SDRRDTSAV_"00",1)," Patient Recalls: ",SDRRCNT,", Available Slots: ",$$OPENSLOT^SDRRISRU($PIECE(SDRRCLIN,U,2),$SELECT(SDRRDTSAV=$EXTRACT(SDRRMDT,1,5):SDRRMDT,1:SDRRDTSAV_"01"))
+5 IF SDRRDTSAV=$EXTRACT(SDRRMDT,1,5)
WRITE " (",SDRRMDTX," through EOM)"
+6 QUIT
