SDRRSEG3 ;10N20/MAH;Display Future Clinic Recalls in Brief Patient Inquiry; 1/15/08
;;5.3;Scheduling;**536**;Aug 13, 1993;Build 53
N I,Y,CLINIC,C,D,KEY
W !!,"Future Clinic Recalls:"
I '$D(^SD(403.5,"B",DFN)) W ?25,"<No Clinic Recall on file>",! G EXIT
W !
W ?2,"Clinic",?32,"Recall Date",?55,"Notice Sent",!
F Q=1:1:79 W "="
EN1 ;
K ^TMP("SDRRCLR")
S C=0 F I=0:0 S I=$O(^SD(403.5,"B",DFN,I)) Q:'I I $D(^SD(403.5,I,0)) S D=^(0),C=C+1 S ^TMP("SDRRCLR",$J,C)=I_"^"_D
S (ER,OK)=0 W ! F S I=$O(^TMP("SDRRCLR",$J,I)) Q:'I S CLINIC=$P($G(^TMP("SDRRCLR",$J,I)),"^",3) D
.I CLINIC'="" S CLINIC=$$GET1^DIQ(44,CLINIC_",",.01)
.I CLINIC="" S CLINIC="UNK. CLINIC"
.S PROV=$P($G(^TMP("SDRRCLR",$J,I)),"^",6) I PROV'="" S PROV=$P($G(^SD(403.54,PROV,0)),"^",1) I PROV'="" S PROV=$$NAME^XUSER(PROV,"F")
.I PROV="" S PROV="UNK. PROVIDER"
.S RDT="",RDT=$P(^TMP("SDRRCLR",$J,I),"^",7) I $G(RDT)]"" S Y=RDT D DD^%DT S RDT=Y
.S RS=$P(^TMP("SDRRCLR",$J,I),"^",11) I $G(RS)]"" S Y=RS D DD^%DT S RS=Y
.I RS="" S RS="NO"
.W ?2,$E(CLINIC,1,30),?32,RDT,?55,RS,! S Z=I
EXIT ;
K ER,OK,PROV,RDT,RS,X,Z,Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRRSEG3 1124 printed Dec 13, 2024@03:00:56 Page 2
SDRRSEG3 ;10N20/MAH;Display Future Clinic Recalls in Brief Patient Inquiry; 1/15/08
+1 ;;5.3;Scheduling;**536**;Aug 13, 1993;Build 53
+2 NEW I,Y,CLINIC,C,D,KEY
+3 WRITE !!,"Future Clinic Recalls:"
+4 IF '$DATA(^SD(403.5,"B",DFN))
WRITE ?25,"<No Clinic Recall on file>",!
GOTO EXIT
+5 WRITE !
+6 WRITE ?2,"Clinic",?32,"Recall Date",?55,"Notice Sent",!
+7 FOR Q=1:1:79
WRITE "="
EN1 ;
+1 KILL ^TMP("SDRRCLR")
+2 SET C=0
FOR I=0:0
SET I=$ORDER(^SD(403.5,"B",DFN,I))
if 'I
QUIT
IF $DATA(^SD(403.5,I,0))
SET D=^(0)
SET C=C+1
SET ^TMP("SDRRCLR",$JOB,C)=I_"^"_D
+3 SET (ER,OK)=0
WRITE !
FOR
SET I=$ORDER(^TMP("SDRRCLR",$JOB,I))
if 'I
QUIT
SET CLINIC=$PIECE($GET(^TMP("SDRRCLR",$JOB,I)),"^",3)
Begin DoDot:1
+4 IF CLINIC'=""
SET CLINIC=$$GET1^DIQ(44,CLINIC_",",.01)
+5 IF CLINIC=""
SET CLINIC="UNK. CLINIC"
+6 SET PROV=$PIECE($GET(^TMP("SDRRCLR",$JOB,I)),"^",6)
IF PROV'=""
SET PROV=$PIECE($GET(^SD(403.54,PROV,0)),"^",1)
IF PROV'=""
SET PROV=$$NAME^XUSER(PROV,"F")
+7 IF PROV=""
SET PROV="UNK. PROVIDER"
+8 SET RDT=""
SET RDT=$PIECE(^TMP("SDRRCLR",$JOB,I),"^",7)
IF $GET(RDT)]""
SET Y=RDT
DO DD^%DT
SET RDT=Y
+9 SET RS=$PIECE(^TMP("SDRRCLR",$JOB,I),"^",11)
IF $GET(RS)]""
SET Y=RS
DO DD^%DT
SET RS=Y
+10 IF RS=""
SET RS="NO"
+11 WRITE ?2,$EXTRACT(CLINIC,1,30),?32,RDT,?55,RS,!
SET Z=I
End DoDot:1
EXIT ;
+1 KILL ER,OK,PROV,RDT,RS,X,Z,Q
+2 QUIT
