SDRRISRX ;10N20/MAH;-Recall List Clerk Deletions;01/18/2008 11:32
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
; Option: SDRR RECALL DELETIONS
EN ;
N SDRRST,SDRRND,SDRRSTX,SDRRNDX,SDRRBRK,SDRRABORT,I,ZTSAVE,XMDUZ,XMSUB,ZTSK,VA,VADM,VAPA
N SDRRDIV,SDRRDAYS,DIR,X,Y,Z,DIRUT,ZTQUEUED,ZTDESC,DFN
I '$D(^SD(403.56,"C")) W !!,"***No Entries Have Been Deleted***" Q
S SDRRABORT=0
W !!,"Select a time period and a set of clinics, and I'll tell you all the patients"
W !,"who were on the Recall List, but were deleted from the list by clerks."
W !!,"First select the Recall Date range. The default dates are determined by the"
W !,"entries in Recall Reminders Removed File."
S SDRRST=$O(^SD(403.56,"C",""))
S SDRRND=$O(^SD(403.56,"C",""),-1)
D DRANGE^SDRRUTL(.SDRRST,.SDRRND,.SDRRSTX,.SDRRNDX,.SDRRABORT,SDRRST,SDRRND) 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)
S SDRRBRK=Y ; Page break on Clinic
S XMSUB="Recall List Clerk Deletions, "_$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^SDRRISRX",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)
D KVAR^VADPT
Q
GATHER ; Gather Patient from Recall Deletions List
N SDRRDT,SDRRIEN,SDRRDFN,SDRRREC,SDRRDFN0,SDRRCLIN,SDRRSDT,SDRRDDT,SDRRREC2,SDRRCLERK,SDRRREASN
S SDRRND=SDRRND+.9999
S (SDRRCLIN,SDRRIEN)="" ; "D" xref is on Clinic and Recall Date
F S SDRRCLIN=$O(SDRRCLIST(SDRRCLIN)) Q:'SDRRCLIN D
. Q:'$D(^SD(403.56,"D",SDRRCLIN))
. S SDRRDT=SDRRST-.1
. F S SDRRDT=$O(^SD(403.56,"D",SDRRCLIN,SDRRDT)) Q:SDRRDT>SDRRND!'SDRRDT D
. . F S SDRRIEN=$O(^SD(403.56,"D",SDRRCLIN,SDRRDT,SDRRIEN)) Q:'SDRRIEN D
. . . S SDRRREC2=$G(^SD(403.56,SDRRIEN,2))
. . . S SDRRDDT=+SDRRREC2 ; Deletion date
. . . Q:'SDRRDDT ; got appt.?
. . . S SDRRCLERK=$P(SDRRREC2,U,2)
. . . S SDRRREASN=$P(SDRRREC2,U,3)
. . . S SDRRREC=$G(^SD(403.56,SDRRIEN,0))
. . . S SDRRDFN=+SDRRREC
. . . Q:$$TESTPAT^VADPT(SDRRDFN) ; Test patient
. . . S DFN=SDRRDFN
. . .D ADD^VADPT,DEM^VADPT
. . . S SDRRSDT=$P(SDRRREC,U,10) ; Reminder sent date
. . . S Z=$P(SDRRREC,U,13) I Z'="" S Z="*"
. . . S ^TMP("SDRR",$J,"PRT",SDRRCLIST(SDRRCLIN)_U_SDRRCLIN,$P(VADM(1),U)_U_SDRRDFN,SDRRDT)=$P(VA("BID"),U)_U_SDRRSDT_U_Z_U_SDRRDDT_U_SDRRCLERK_U_SDRRREASN
Q
PRINT ;
N SDRRTODAY,SDRRCLIN,SDRRCLSAV,SDRRDT,SDRRREC,SDRRPAGE,SDRRABORT,SDRRDR,SDRRRP
N SDRRPAT,SDRRSSN,SDRRCNT,SDRRDTX,SDRRSDT,SDRRPROV,SDRRDFN,SDRRDDT,SDRRREASN
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 List deletions found for this date range." Q
S (SDRRCLIN,SDRRPAT,SDRRDT)=""
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 SDRRCNT=0
. F S SDRRPAT=$O(^TMP("SDRR",$J,"PRT",SDRRCLIN,SDRRPAT)) Q:SDRRPAT="" D Q:SDRRABORT
. . S SDRRDFN=$P(SDRRPAT,U,2)
. . F S SDRRDT=$O(^TMP("SDRR",$J,"PRT",SDRRCLIN,SDRRPAT,SDRRDT)) Q:'SDRRDT S SDRRREC=^(SDRRDT) D Q:SDRRABORT
. . . S SDRRCNT=SDRRCNT+1
. . . S SDRRSSN=$E(SDRRREC,1,4)
. . . S SDRRSDT=$P(SDRRREC,U,2)
. . . S SDRRRP=$P(SDRRREC,U,3)
. . . S SDRRDDT=$P(SDRRREC,U,4)
. . . S SDRRCLERK=$P(SDRRREC,U,5) S SDRRCLERK=$$NAME^XUSER(SDRRCLERK,"F")
. . . S SDRRREASN=$S($P(SDRRREC,U,6)=1:"FTR",$P(SDRRREC,U,6)=2:"MOVED",$P(SDRRREC,U,6)=3:"DECEASED",$P(SDRRREC,U,6)=4:"DNWC",$P(SDRRREC,U,6)=5:"RCOVA",$P(SDRRREC,U,6)=6:"OTHER",1:"")
. . . 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,SDRRRP_$$FMTE^XLFDT($E(SDRRSDT,1,7),"2Z"),?29,$$FMTE^XLFDT($E(SDRRDT,1,7),"2Z"),?38,$$FMTE^XLFDT($E(SDRRDDT,1,7),"2Z"),?47,$E(SDRRCLERK,1,19),?67,SDRRREASN
. Q:SDRRABORT
. D SUBTOT
Q:SDRRABORT
I SDRRIA D WAIT^XMXUTIL
Q
S SDRRPAGE=SDRRPAGE+1
W SDRRDR,$J(SDRRPAGE,3)
W !!,?20,"Reminder"
W !,"Patient",?15,"SSN",?20,"Sent",?29,"Recall",?38,"Deleted",?47,"Deleted by",?67,"Reason"
W !,"-------------- ---- -------- -------- -------- ------------------- ------"
Q
SUBTOT ;
I $Y+3+SDRRIA>IOSL D Q:SDRRABORT
. I SDRRIA D PAGE^XMXUTIL(.SDRRABORT) Q:SDRRABORT
. W @IOF D HEADER
W !!,"Patient Recall List Deletions: ",SDRRCNT
Q
SDRRISRX ;10N20/MAH;-Recall List Clerk Deletions;01/18/2008 11:32
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
+2 ; Option: SDRR RECALL DELETIONS
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,DIRUT,ZTQUEUED,ZTDESC,DFN
+3 IF '$DATA(^SD(403.56,"C"))
WRITE !!,"***No Entries Have Been Deleted***"
QUIT
+4 SET SDRRABORT=0
+5 WRITE !!,"Select a time period and a set of clinics, and I'll tell you all the patients"
+6 WRITE !,"who were on the Recall List, but were deleted from the list by clerks."
+7 WRITE !!,"First select the Recall Date range. The default dates are determined by the"
+8 WRITE !,"entries in Recall Reminders Removed File."
+9 SET SDRRST=$ORDER(^SD(403.56,"C",""))
+10 SET SDRRND=$ORDER(^SD(403.56,"C",""),-1)
+11 DO DRANGE^SDRRUTL(.SDRRST,.SDRRND,.SDRRSTX,.SDRRNDX,.SDRRABORT,SDRRST,SDRRND)
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 KILL 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="Recall List Clerk Deletions, "_$SELECT(SDRRST=SDRRND:SDRRSTX,1:SDRRSTX_"-"_SDRRNDX)
+23 FOR I="SDRRDIV","SDRRDIV(","SDRRST","SDRRSTX","SDRRND","SDRRNDX","SDRRBRK","SDRRDAYS","^TMP(""SDRR"",$J,"
SET ZTSAVE(I)=""
+24 DO EN^XUTMDEVQ("CONTROL^SDRRISRX",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 DO KVAR^VADPT
+8 QUIT
GATHER ; Gather Patient from Recall Deletions List
+1 NEW SDRRDT,SDRRIEN,SDRRDFN,SDRRREC,SDRRDFN0,SDRRCLIN,SDRRSDT,SDRRDDT,SDRRREC2,SDRRCLERK,SDRRREASN
+2 SET SDRRND=SDRRND+.9999
+3 ; "D" xref is on Clinic and Recall Date
SET (SDRRCLIN,SDRRIEN)=""
+4 FOR
SET SDRRCLIN=$ORDER(SDRRCLIST(SDRRCLIN))
IF 'SDRRCLIN
QUIT
Begin DoDot:1
+5 IF '$DATA(^SD(403.56,"D",SDRRCLIN))
QUIT
+6 SET SDRRDT=SDRRST-.1
+7 FOR
SET SDRRDT=$ORDER(^SD(403.56,"D",SDRRCLIN,SDRRDT))
IF SDRRDT>SDRRND!'SDRRDT
QUIT
Begin DoDot:2
+8 FOR
SET SDRRIEN=$ORDER(^SD(403.56,"D",SDRRCLIN,SDRRDT,SDRRIEN))
IF 'SDRRIEN
QUIT
Begin DoDot:3
+9 SET SDRRREC2=$GET(^SD(403.56,SDRRIEN,2))
+10 ; Deletion date
SET SDRRDDT=+SDRRREC2
+11 ; got appt.?
IF 'SDRRDDT
QUIT
+12 SET SDRRCLERK=$PIECE(SDRRREC2,U,2)
+13 SET SDRRREASN=$PIECE(SDRRREC2,U,3)
+14 SET SDRRREC=$GET(^SD(403.56,SDRRIEN,0))
+15 SET SDRRDFN=+SDRRREC
+16 ; Test patient
IF $$TESTPAT^VADPT(SDRRDFN)
QUIT
+17 SET DFN=SDRRDFN
+18 DO ADD^VADPT
DO DEM^VADPT
+19 ; Reminder sent date
SET SDRRSDT=$PIECE(SDRRREC,U,10)
+20 SET Z=$PIECE(SDRRREC,U,13)
IF Z'=""
SET Z="*"
+21 SET ^TMP("SDRR",$JOB,"PRT",SDRRCLIST(SDRRCLIN)_U_SDRRCLIN,$PIECE(VADM(1),U)_U_SDRRDFN,SDRRDT)=$PIECE(VA("BID"),U)_U_SDRRSDT_U_Z_U_SDRRDDT_U_SDRRCLERK_U_SDRRREASN
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT
PRINT ;
+1 NEW SDRRTODAY,SDRRCLIN,SDRRCLSAV,SDRRDT,SDRRREC,SDRRPAGE,SDRRABORT,SDRRDR,SDRRRP
+2 NEW SDRRPAT,SDRRSSN,SDRRCNT,SDRRDTX,SDRRSDT,SDRRPROV,SDRRDFN,SDRRDDT,SDRRREASN
+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 List deletions found for this date range."
QUIT
+11 SET (SDRRCLIN,SDRRPAT,SDRRDT)=""
+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+5+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 SDRRPAT=$ORDER(^TMP("SDRR",$JOB,"PRT",SDRRCLIN,SDRRPAT))
IF SDRRPAT=""
QUIT
Begin DoDot:2
+23 SET SDRRDFN=$PIECE(SDRRPAT,U,2)
+24 FOR
SET SDRRDT=$ORDER(^TMP("SDRR",$JOB,"PRT",SDRRCLIN,SDRRPAT,SDRRDT))
IF 'SDRRDT
QUIT
SET SDRRREC=^(SDRRDT)
Begin DoDot:3
+25 SET SDRRCNT=SDRRCNT+1
+26 SET SDRRSSN=$EXTRACT(SDRRREC,1,4)
+27 SET SDRRSDT=$PIECE(SDRRREC,U,2)
+28 SET SDRRRP=$PIECE(SDRRREC,U,3)
+29 SET SDRRDDT=$PIECE(SDRRREC,U,4)
+30 SET SDRRCLERK=$PIECE(SDRRREC,U,5)
SET SDRRCLERK=$$NAME^XUSER(SDRRCLERK,"F")
+31 SET SDRRREASN=$SELECT($PIECE(SDRRREC,U,6)=1:"FTR",$PIECE(SDRRREC,U,6)=2:"MOVED",$PIECE(SDRRREC,U,6)=3:"DECEASED",$PIECE(SDRRREC,U,6)=4:"DNWC",$PIECE(SDRRREC,U,6)=5:"RCOVA",$PIECE(SDRRREC,U,6)=6:"OTHER",1:"")
+32 IF $Y+2+SDRRIA>IOSL
Begin DoDot:4
+33 IF SDRRIA
DO PAGE^XMXUTIL(.SDRRABORT)
IF SDRRABORT
QUIT
+34 WRITE @IOF
DO HEADER
End DoDot:4
IF SDRRABORT
QUIT
+35 WRITE !,$EXTRACT($PIECE(SDRRPAT,U),1,14),?15,SDRRSSN,?20,SDRRRP_$$FMTE^XLFDT($EXTRACT(SDRRSDT,1,7),"2Z"),?29,$$FMTE^XLFDT($EXTRACT(SDRRDT,1,7),"2Z"),?38,$$FMTE^XLFDT($EXTRACT(SDRRDDT,1,7),"2Z"),?47,$EXTRACT(SDRRCLERK,1,1
9),?67,SDRRREASN
End DoDot:3
IF SDRRABORT
QUIT
End DoDot:2
IF SDRRABORT
QUIT
+36 IF SDRRABORT
QUIT
+37 DO SUBTOT
End DoDot:1
IF SDRRABORT
QUIT
+38 IF SDRRABORT
QUIT
+39 IF SDRRIA
DO WAIT^XMXUTIL
+40 QUIT
+1 SET SDRRPAGE=SDRRPAGE+1
+2 WRITE SDRRDR,$JUSTIFY(SDRRPAGE,3)
+3 WRITE !!,?20,"Reminder"
+4 WRITE !,"Patient",?15,"SSN",?20,"Sent",?29,"Recall",?38,"Deleted",?47,"Deleted by",?67,"Reason"
+5 WRITE !,"-------------- ---- -------- -------- -------- ------------------- ------"
+6 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 !!,"Patient Recall List Deletions: ",SDRRCNT
+5 QUIT
