SD53P566 ;ALB/RLC - POST-INIT TO IDENTIFY MISSING CLINICS IN 403.5; 7/27/07
;;5.3;SCHEDULING;**566**;Aug 13, 1993;Build 5
;
; THIS POST-INIT ROUTINE WILL READ THROUGH THE RECALL REMINDERS FILE
; #403.5 AND PROVIDE A REPORT IDENTIFYING ALL ACTIVE/OPEN RECALL
; REMINDERS THAT ARE MISSING A CLINIC.
;
Q ; must call at entry point
;
EN ; entry point
K ^TMP("RR REPORT",$J)
S IEN=0,(NODE,SDATE,PROV)=""
F S IEN=$O(^SD(403.5,IEN)) Q:'IEN D
.Q:'$D(^SD(403.5,IEN,0)) S NODE=^(0)
.Q:$P(NODE,U,1)=""
.Q:$P(NODE,U,2)'="" ;quit - record contains clinic
.S PAT=$P(^DPT($P(NODE,U,1),0),U,1) ;get patient name
.S PROV=$P(NODE,U,5) I PROV'="" S PROV=$P($G(^SD(403.54,PROV,0)),U,1) I PROV'="" S PROV=$$NAME^XUSER(PROV,"F")
.S:PROV="" PROV="UNKNOWN"
.S SDATE=$$FMTE^XLFDT($P(NODE,U,6),1)
.S ^TMP("RR REPORT",$J,PAT,IEN)=SDATE_U_PROV
D MSG
K IEN,NODE,PAT,PROV,SDATE,^TMP("RR REPORT",$J)
Q
;
MSG ;Send message containing list of recall reminders with missing clinic
N DVPARAM,XMDUZ,XMSUB,XMTEXT,XMY,MSGTXT,CT,TAB,TAB1,SP,SP1
S (SDATE,PROV)=""
S CT=0
I '$D(^TMP("RR REPORT",$J)) D NONE,MSG1 Q
S CT=CT+1,MSGTXT(CT)="THE FOLLOWING PATIENTS HAVE ONE OR MORE ACTIVE RECORDS"
S CT=CT+1,MSGTXT(CT)="IN THE RECALL REMINDERS FILE #403.5, THAT ARE MISSING"
S CT=CT+1,MSGTXT(CT)="A REQUIRED CLINIC. PLEASE UPDATE EACH OF THESE RECALL"
S CT=CT+1,MSGTXT(CT)="REMINDERS WITH THE APPLICABLE CLINIC."
S CT=CT+1,MSGTXT(CT)=""
S CT=CT+1,MSGTXT(CT)=""
S TAB=" " F I=1:1:26 S TAB=TAB_" "
S TAB1=" " F I=1:1:12 S TAB1=TAB1_" "
S CT=CT+1,MSGTXT(CT)="PATIENT"_TAB_"DATE"_TAB1_"PROVIDER"
S CT=CT+1 F I=1:1:80 S MSGTXT(CT)="-"
S PAT=""
F S PAT=$O(^TMP("RR REPORT",$J,PAT)) Q:PAT="" D
. S IEN=0,RCD=""
. F S IEN=$O(^TMP("RR REPORT",$J,PAT,IEN)) Q:'IEN D
..S RCD=^(IEN),SDATE=$P(RCD,U,1),PROV=$P(RCD,U,2)
..S SP=" " F I=1:1:33-$L(PAT) S SP=SP_" "
..S SP1=" " F I=1:1:4 S SP1=SP1_" "
..S CT=CT+1,MSGTXT(CT)=PAT_SP_SDATE_SP1_PROV
..S CT=CT+1,MSGTXT(CT)=""
MSG1 S XMTEXT="MSGTXT"
S DVPARAM("FROM")="RECALL REMINDERS REPORT FOR PATCH SD*5.3*566"
S XMDUZ=DUZ,XMSUB="RECALL REMINDERS MISSING REQUIRED CLINIC",XMY(DUZ)=""
D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.DVPARAM,"","")
K XMDUZ,XMSUB,XMY,XMTEXT,DVPARAM,CT,MSGTXT,TAB,TAB1,SP,SP1,PAT,IEN
K RCD,DATE,PROV,I
Q
;
NONE ;No records found with missing clinic in file 403.5
S CT=CT+1,MSGTXT(CT)="NO RECORDS WERE FOUND IN THE RECALL REMINDERS FILE #403.5"
S CT=CT+1,MSGTXT(CT)="THAT ARE MISSING A REQUIRED CLINIC."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53P566 2546 printed Nov 22, 2024@17:56:28 Page 2
SD53P566 ;ALB/RLC - POST-INIT TO IDENTIFY MISSING CLINICS IN 403.5; 7/27/07
+1 ;;5.3;SCHEDULING;**566**;Aug 13, 1993;Build 5
+2 ;
+3 ; THIS POST-INIT ROUTINE WILL READ THROUGH THE RECALL REMINDERS FILE
+4 ; #403.5 AND PROVIDE A REPORT IDENTIFYING ALL ACTIVE/OPEN RECALL
+5 ; REMINDERS THAT ARE MISSING A CLINIC.
+6 ;
+7 ; must call at entry point
QUIT
+8 ;
EN ; entry point
+1 KILL ^TMP("RR REPORT",$JOB)
+2 SET IEN=0
SET (NODE,SDATE,PROV)=""
+3 FOR
SET IEN=$ORDER(^SD(403.5,IEN))
if 'IEN
QUIT
Begin DoDot:1
+4 if '$DATA(^SD(403.5,IEN,0))
QUIT
SET NODE=^(0)
+5 if $PIECE(NODE,U,1)=""
QUIT
+6 ;quit - record contains clinic
if $PIECE(NODE,U,2)'=""
QUIT
+7 ;get patient name
SET PAT=$PIECE(^DPT($PIECE(NODE,U,1),0),U,1)
+8 SET PROV=$PIECE(NODE,U,5)
IF PROV'=""
SET PROV=$PIECE($GET(^SD(403.54,PROV,0)),U,1)
IF PROV'=""
SET PROV=$$NAME^XUSER(PROV,"F")
+9 if PROV=""
SET PROV="UNKNOWN"
+10 SET SDATE=$$FMTE^XLFDT($PIECE(NODE,U,6),1)
+11 SET ^TMP("RR REPORT",$JOB,PAT,IEN)=SDATE_U_PROV
End DoDot:1
+12 DO MSG
+13 KILL IEN,NODE,PAT,PROV,SDATE,^TMP("RR REPORT",$JOB)
+14 QUIT
+15 ;
MSG ;Send message containing list of recall reminders with missing clinic
+1 NEW DVPARAM,XMDUZ,XMSUB,XMTEXT,XMY,MSGTXT,CT,TAB,TAB1,SP,SP1
+2 SET (SDATE,PROV)=""
+3 SET CT=0
+4 IF '$DATA(^TMP("RR REPORT",$JOB))
DO NONE
DO MSG1
QUIT
+5 SET CT=CT+1
SET MSGTXT(CT)="THE FOLLOWING PATIENTS HAVE ONE OR MORE ACTIVE RECORDS"
+6 SET CT=CT+1
SET MSGTXT(CT)="IN THE RECALL REMINDERS FILE #403.5, THAT ARE MISSING"
+7 SET CT=CT+1
SET MSGTXT(CT)="A REQUIRED CLINIC. PLEASE UPDATE EACH OF THESE RECALL"
+8 SET CT=CT+1
SET MSGTXT(CT)="REMINDERS WITH THE APPLICABLE CLINIC."
+9 SET CT=CT+1
SET MSGTXT(CT)=""
+10 SET CT=CT+1
SET MSGTXT(CT)=""
+11 SET TAB=" "
FOR I=1:1:26
SET TAB=TAB_" "
+12 SET TAB1=" "
FOR I=1:1:12
SET TAB1=TAB1_" "
+13 SET CT=CT+1
SET MSGTXT(CT)="PATIENT"_TAB_"DATE"_TAB1_"PROVIDER"
+14 SET CT=CT+1
FOR I=1:1:80
SET MSGTXT(CT)="-"
+15 SET PAT=""
+16 FOR
SET PAT=$ORDER(^TMP("RR REPORT",$JOB,PAT))
if PAT=""
QUIT
Begin DoDot:1
+17 SET IEN=0
SET RCD=""
+18 FOR
SET IEN=$ORDER(^TMP("RR REPORT",$JOB,PAT,IEN))
if 'IEN
QUIT
Begin DoDot:2
+19 SET RCD=^(IEN)
SET SDATE=$PIECE(RCD,U,1)
SET PROV=$PIECE(RCD,U,2)
+20 SET SP=" "
FOR I=1:1:33-$LENGTH(PAT)
SET SP=SP_" "
+21 SET SP1=" "
FOR I=1:1:4
SET SP1=SP1_" "
+22 SET CT=CT+1
SET MSGTXT(CT)=PAT_SP_SDATE_SP1_PROV
+23 SET CT=CT+1
SET MSGTXT(CT)=""
End DoDot:2
End DoDot:1
MSG1 SET XMTEXT="MSGTXT"
+1 SET DVPARAM("FROM")="RECALL REMINDERS REPORT FOR PATCH SD*5.3*566"
+2 SET XMDUZ=DUZ
SET XMSUB="RECALL REMINDERS MISSING REQUIRED CLINIC"
SET XMY(DUZ)=""
+3 DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.DVPARAM,"","")
+4 KILL XMDUZ,XMSUB,XMY,XMTEXT,DVPARAM,CT,MSGTXT,TAB,TAB1,SP,SP1,PAT,IEN
+5 KILL RCD,DATE,PROV,I
+6 QUIT
+7 ;
NONE ;No records found with missing clinic in file 403.5
+1 SET CT=CT+1
SET MSGTXT(CT)="NO RECORDS WERE FOUND IN THE RECALL REMINDERS FILE #403.5"
+2 SET CT=CT+1
SET MSGTXT(CT)="THAT ARE MISSING A REQUIRED CLINIC."
+3 QUIT
+4 ;
