SDRRSEG3.m

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 ---SDRRSEG3   1124     printed  Apr 09, 2024@21:44:59                                                                                                                                                                                                    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