SDRRREP ;ALB/SAT - RECALL REMINDERS REPORTS ;JUL 26, 2017
;;5.3;Scheduling;**643,672,727**;Aug 13, 1993;Build 2
;
LETTER ;REPORT - RECALL REMINDERS where associated Clinic does not have a Recall Letter defined
N SDRRDESC,SDRRRTN,SDTMP
N %ZIS,IO,IOP,IOSL,IOST,POP,ZTDESC,ZTQUEUED,ZTREQ,ZTRTN,ZTSK,ZTSAVE
D INIT
;
K %ZIS,IOP S %ZIS="MQ" W ! D ^%ZIS I POP D EXIT Q
;
I $D(IO("Q")) D Q
. S ZTDESC=SDRRDESC
. S ZTRTN="PROCESS^SDRRREP"
. S ZTSAVE("*")="" ;*727
. D TASK
;
D PROCESS
Q
;
INIT ;
S SDRRRTN="SDRRREP"
S SDRRDESC="Recall Letter Report"
S SDTMP=$NA(^TMP(SDRRRTN,$J))
K @SDTMP
Q
;
PROCESS ;
N SDDTIM,SDQUIT,SDRPAGE,SDTIME,SDTODAY,SDUNDL
D SETUP,SORT,RPT
I '$D(@SDTMP) W !!?26,"* * * NO DATA TO PRINT * * *",!!
D EXIT
Q
;
SETUP ;
S (SDQUIT,SDRPAGE)=0
S SDDTIM=$$HTE^XLFDT($H,1)
S SDTIME=$P(SDDTIM,"@",2)
S SDTODAY=$P(SDDTIM,"@")_" "_$E(SDTIME,1,5)
S $P(SDUNDL,"-",78)="-"
Q
;
SORT ; get recall entries associated to clinics with no recall letter
N DFN,SDC,SDCL,SDATE,SDCLN,SDI,SDNAM,SSN
S SDC=0
S SDCL=0 F S SDCL=$O(^SD(403.5,"E",SDCL)) Q:SDCL="" D
.Q:$O(^SD(403.52,"B",SDCL,0))
.S SDCLN=$$GET1^DIQ(44,SDCL_",",.01)
.Q:SDCLN="" ;alb/sat 672 - skip if clinic name not defined
.S SDI=0 F S SDI=$O(^SD(403.5,"E",SDCL,SDI)) Q:SDI="" D
..S DFN=$$GET1^DIQ(403.5,SDI_",",.01,"I")
..Q:(DFN="")!('$D(^DPT(+DFN,0))) ;alb/sat 672 - skip if patient not defined
..S SDNAM=$$GET1^DIQ(2,DFN_",",.01) S:SDNAM="" SDNAM="No Name" ;alb/sat 672 - make sure a value is in SDNAM
..S SDATE=$$GET1^DIQ(403.5,SDI_",",5)
..S:SDATE="" SDATE=0 ;alb/sat 672 - make sure a value is in SDATE
..S SSN=$E($P(^DPT(DFN,0),"^",9),6,9) S:SSN="" SSN=0
..S SDC=SDC+1 S @SDTMP@(SDCLN,SDATE,SDNAM,SSN,SDC)="" ;alb/sat 672 - use SDNAM
Q
;
RPT ; Print the report
N SDATE,SDC,SDCLN,SDNAME,SDSSN
U IO
;
D HEADER
; Loop through the Sorted data.
S SDCLN="" F S SDCLN=$O(@SDTMP@(SDCLN)) Q:SDCLN="" D Q:SDQUIT
.S SDATE="" F S SDATE=$O(@SDTMP@(SDCLN,SDATE)) Q:SDATE="" D Q:SDQUIT
..S SDNAME="" F S SDNAME=$O(@SDTMP@(SDCLN,SDATE,SDNAME)) Q:SDNAME="" D Q:SDQUIT
...S SDSSN="" F S SDSSN=$O(@SDTMP@(SDCLN,SDATE,SDNAME,SDSSN)) Q:SDSSN="" D Q:SDQUIT
....S SDC="" F S SDC=$O(@SDTMP@(SDCLN,SDATE,SDNAME,SDSSN,SDC)) Q:SDC="" D Q:SDQUIT
.....I $Y>(IOSL-6) D HEADER Q:SDQUIT
.....W !,SDCLN,?30,SDATE,?43,SDNAME,?74,$S(SDSSN=0:"",1:SDSSN)
Q
;
N DIR,Y
S SDRPAGE=SDRPAGE+1
I SDRPAGE>1 D Q:SDQUIT
. W $C(7)
. I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S SDQUIT=$S(Y'>0:1,1:0)
;
W:$E(IOST)="C"!(SDRPAGE>1) @IOF
W !,SDRRDESC,?48,SDTODAY,?70,"PAGE ",SDRPAGE
W !,"Clinic",?30,"Recall Date",?43,"Patient Name",?75,"SSN"
W !,SDUNDL
;
Q
;
EXIT ;
W ! D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
K @SDTMP
Q
;
TASK ;set variables for call to ^%ZTLOAD
D ^%ZTLOAD
I $G(ZTSK) W !,"Task Number: ",ZTSK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRRREP 2939 printed Nov 22, 2024@18:10:47 Page 2
SDRRREP ;ALB/SAT - RECALL REMINDERS REPORTS ;JUL 26, 2017
+1 ;;5.3;Scheduling;**643,672,727**;Aug 13, 1993;Build 2
+2 ;
LETTER ;REPORT - RECALL REMINDERS where associated Clinic does not have a Recall Letter defined
+1 NEW SDRRDESC,SDRRRTN,SDTMP
+2 NEW %ZIS,IO,IOP,IOSL,IOST,POP,ZTDESC,ZTQUEUED,ZTREQ,ZTRTN,ZTSK,ZTSAVE
+3 DO INIT
+4 ;
+5 KILL %ZIS,IOP
SET %ZIS="MQ"
WRITE !
DO ^%ZIS
IF POP
DO EXIT
QUIT
+6 ;
+7 IF $DATA(IO("Q"))
Begin DoDot:1
+8 SET ZTDESC=SDRRDESC
+9 SET ZTRTN="PROCESS^SDRRREP"
+10 ;*727
SET ZTSAVE("*")=""
+11 DO TASK
End DoDot:1
QUIT
+12 ;
+13 DO PROCESS
+14 QUIT
+15 ;
INIT ;
+1 SET SDRRRTN="SDRRREP"
+2 SET SDRRDESC="Recall Letter Report"
+3 SET SDTMP=$NAME(^TMP(SDRRRTN,$JOB))
+4 KILL @SDTMP
+5 QUIT
+6 ;
PROCESS ;
+1 NEW SDDTIM,SDQUIT,SDRPAGE,SDTIME,SDTODAY,SDUNDL
+2 DO SETUP
DO SORT
DO RPT
+3 IF '$DATA(@SDTMP)
WRITE !!?26,"* * * NO DATA TO PRINT * * *",!!
+4 DO EXIT
+5 QUIT
+6 ;
SETUP ;
+1 SET (SDQUIT,SDRPAGE)=0
+2 SET SDDTIM=$$HTE^XLFDT($HOROLOG,1)
+3 SET SDTIME=$PIECE(SDDTIM,"@",2)
+4 SET SDTODAY=$PIECE(SDDTIM,"@")_" "_$EXTRACT(SDTIME,1,5)
+5 SET $PIECE(SDUNDL,"-",78)="-"
+6 QUIT
+7 ;
SORT ; get recall entries associated to clinics with no recall letter
+1 NEW DFN,SDC,SDCL,SDATE,SDCLN,SDI,SDNAM,SSN
+2 SET SDC=0
+3 SET SDCL=0
FOR
SET SDCL=$ORDER(^SD(403.5,"E",SDCL))
if SDCL=""
QUIT
Begin DoDot:1
+4 if $ORDER(^SD(403.52,"B",SDCL,0))
QUIT
+5 SET SDCLN=$$GET1^DIQ(44,SDCL_",",.01)
+6 ;alb/sat 672 - skip if clinic name not defined
if SDCLN=""
QUIT
+7 SET SDI=0
FOR
SET SDI=$ORDER(^SD(403.5,"E",SDCL,SDI))
if SDI=""
QUIT
Begin DoDot:2
+8 SET DFN=$$GET1^DIQ(403.5,SDI_",",.01,"I")
+9 ;alb/sat 672 - skip if patient not defined
if (DFN="")!('$DATA(^DPT(+DFN,0)))
QUIT
+10 ;alb/sat 672 - make sure a value is in SDNAM
SET SDNAM=$$GET1^DIQ(2,DFN_",",.01)
if SDNAM=""
SET SDNAM="No Name"
+11 SET SDATE=$$GET1^DIQ(403.5,SDI_",",5)
+12 ;alb/sat 672 - make sure a value is in SDATE
if SDATE=""
SET SDATE=0
+13 SET SSN=$EXTRACT($PIECE(^DPT(DFN,0),"^",9),6,9)
if SSN=""
SET SSN=0
+14 ;alb/sat 672 - use SDNAM
SET SDC=SDC+1
SET @SDTMP@(SDCLN,SDATE,SDNAM,SSN,SDC)=""
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
RPT ; Print the report
+1 NEW SDATE,SDC,SDCLN,SDNAME,SDSSN
+2 USE IO
+3 ;
+4 DO HEADER
+5 ; Loop through the Sorted data.
+6 SET SDCLN=""
FOR
SET SDCLN=$ORDER(@SDTMP@(SDCLN))
if SDCLN=""
QUIT
Begin DoDot:1
+7 SET SDATE=""
FOR
SET SDATE=$ORDER(@SDTMP@(SDCLN,SDATE))
if SDATE=""
QUIT
Begin DoDot:2
+8 SET SDNAME=""
FOR
SET SDNAME=$ORDER(@SDTMP@(SDCLN,SDATE,SDNAME))
if SDNAME=""
QUIT
Begin DoDot:3
+9 SET SDSSN=""
FOR
SET SDSSN=$ORDER(@SDTMP@(SDCLN,SDATE,SDNAME,SDSSN))
if SDSSN=""
QUIT
Begin DoDot:4
+10 SET SDC=""
FOR
SET SDC=$ORDER(@SDTMP@(SDCLN,SDATE,SDNAME,SDSSN,SDC))
if SDC=""
QUIT
Begin DoDot:5
+11 IF $Y>(IOSL-6)
DO HEADER
if SDQUIT
QUIT
+12 WRITE !,SDCLN,?30,SDATE,?43,SDNAME,?74,$SELECT(SDSSN=0:"",1:SDSSN)
End DoDot:5
if SDQUIT
QUIT
End DoDot:4
if SDQUIT
QUIT
End DoDot:3
if SDQUIT
QUIT
End DoDot:2
if SDQUIT
QUIT
End DoDot:1
if SDQUIT
QUIT
+13 QUIT
+14 ;
+1 NEW DIR,Y
+2 SET SDRPAGE=SDRPAGE+1
+3 IF SDRPAGE>1
Begin DoDot:1
+4 WRITE $CHAR(7)
+5 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET SDQUIT=$SELECT(Y'>0:1,1:0)
End DoDot:1
if SDQUIT
QUIT
+6 ;
+7 if $EXTRACT(IOST)="C"!(SDRPAGE>1)
WRITE @IOF
+8 WRITE !,SDRRDESC,?48,SDTODAY,?70,"PAGE ",SDRPAGE
+9 WRITE !,"Clinic",?30,"Recall Date",?43,"Patient Name",?75,"SSN"
+10 WRITE !,SDUNDL
+11 ;
+12 QUIT
+13 ;
EXIT ;
+1 WRITE !
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL @SDTMP
+3 QUIT
+4 ;
TASK ;set variables for call to ^%ZTLOAD
+1 DO ^%ZTLOAD
+2 IF $GET(ZTSK)
WRITE !,"Task Number: ",ZTSK
+3 QUIT
