- SDRRISRX ;10N20/MAH;-Recall List Clerk Deletions;01/18/2008 11:32
- ;;5.3;Scheduling;**536**;Aug 13, 1993;Build 53
- ; 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRRISRX 5206 printed Mar 13, 2025@22:05:54 Page 2
- SDRRISRX ;10N20/MAH;-Recall List Clerk Deletions;01/18/2008 11:32
- +1 ;;5.3;Scheduling;**536**;Aug 13, 1993;Build 53
- +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
