SDRROR ;10N20/MAH;Recall Reminder CPRS Display;01/15/2008
;;5.3;Scheduling;**536,561,571**;Aug 13, 1993;Build 3
;;This routine is called from ORWCV
;;and will be called if Outpatient Clinic param entry is either
;;null or cards
;VAR BEG,END,AND DFN WILL BE KILLED WITH OR ROUTINES
COVER ; GET RECALL DATES FOR A PATIENT
;At ORWCV TAG VST+24 ADD D COVER^SDRROR
Q:BEG<1!(END<1)
F RCIFN=0:0 S RCIFN=$O(^SD(403.5,"B",DFN,RCIFN)) Q:RCIFN<1 D
.S RCX=$G(^SD(403.5,RCIFN,0)) Q:RCX=""
.S RCDT=$P(RCX,U,6) Q:RCDT<BEG Q:RCDT>END
.S RCTYPE=$P(RCX,U,4),RCCLIN=$P(RCX,U,2)
.S:RCTYPE]"" RCTYPE=$P($G(^SD(403.51,RCTYPE,0)),U,2)
.S:RCCLIN]"" RCCLIN=$$GET1^DIQ(44,RCCLIN_",",.01)
.S DATE1=RCDT S:$D(^TMP("ORVSTLIST",$J,RCDT)) DATE1=RCDT+.0001_RCIFN ;SD*571 added RCIFN so all recalls for same date for patient display in CPRS
.S RCNODE="RECALL ("_RCTYPE_") "_RCCLIN,RCNODE=$E(RCNODE,1,45)
.S ^TMP("ORVSTLIST",$J,DATE1,"R",1)="R;"_RCDT_";"_RCIFN_U_RCDT_U_RCNODE
K RCIFN,RCX,RCTYPE,RCCLIN,RCDT,RCNODE,DATE1
Q
RCDTL ; RECALL DETAILS At ORWCV TAG DTLVST+18 ADD I $P(APPTINFO,";")="R" D RCDTL^SDRROR
S RPT(1)="The patient will be sent a letter prior to this date reminding them to make an" ;SD*561 text changed to read 'prior to this date'
S RPT(2)="appointment with the listed clinic."
S RCIFN=$P(APPTINFO,";",3) Q:RCIFN=""
S APPTINFO=$G(^SD(403.5,RCIFN,0)) Q:APPTINFO=""
S COMM=$P(APPTINFO,U,7),FAST=$P(APPTINFO,U,8)
S:FAST]"" FAST=$P($P(^DD(403.5,2.6,0),FAST_":",2),";")
S RPT(3)=" "
S:FAST]"" RPT(4)="Patient should be "_FAST
S RPT($S(FAST]"":5,1:4))="Comment: "_COMM
K RCIFN,COMM,FAST
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRROR 1635 printed Oct 16, 2024@19:01:14 Page 2
SDRROR ;10N20/MAH;Recall Reminder CPRS Display;01/15/2008
+1 ;;5.3;Scheduling;**536,561,571**;Aug 13, 1993;Build 3
+2 ;;This routine is called from ORWCV
+3 ;;and will be called if Outpatient Clinic param entry is either
+4 ;;null or cards
+5 ;VAR BEG,END,AND DFN WILL BE KILLED WITH OR ROUTINES
COVER ; GET RECALL DATES FOR A PATIENT
+1 ;At ORWCV TAG VST+24 ADD D COVER^SDRROR
+2 if BEG<1!(END<1)
QUIT
+3 FOR RCIFN=0:0
SET RCIFN=$ORDER(^SD(403.5,"B",DFN,RCIFN))
if RCIFN<1
QUIT
Begin DoDot:1
+4 SET RCX=$GET(^SD(403.5,RCIFN,0))
if RCX=""
QUIT
+5 SET RCDT=$PIECE(RCX,U,6)
if RCDT<BEG
QUIT
if RCDT>END
QUIT
+6 SET RCTYPE=$PIECE(RCX,U,4)
SET RCCLIN=$PIECE(RCX,U,2)
+7 if RCTYPE]""
SET RCTYPE=$PIECE($GET(^SD(403.51,RCTYPE,0)),U,2)
+8 if RCCLIN]""
SET RCCLIN=$$GET1^DIQ(44,RCCLIN_",",.01)
+9 ;SD*571 added RCIFN so all recalls for same date for patient display in CPRS
SET DATE1=RCDT
if $DATA(^TMP("ORVSTLIST",$JOB,RCDT))
SET DATE1=RCDT+.0001_RCIFN
+10 SET RCNODE="RECALL ("_RCTYPE_") "_RCCLIN
SET RCNODE=$EXTRACT(RCNODE,1,45)
+11 SET ^TMP("ORVSTLIST",$JOB,DATE1,"R",1)="R;"_RCDT_";"_RCIFN_U_RCDT_U_RCNODE
End DoDot:1
+12 KILL RCIFN,RCX,RCTYPE,RCCLIN,RCDT,RCNODE,DATE1
+13 QUIT
RCDTL ; RECALL DETAILS At ORWCV TAG DTLVST+18 ADD I $P(APPTINFO,";")="R" D RCDTL^SDRROR
+1 ;SD*561 text changed to read 'prior to this date'
SET RPT(1)="The patient will be sent a letter prior to this date reminding them to make an"
+2 SET RPT(2)="appointment with the listed clinic."
+3 SET RCIFN=$PIECE(APPTINFO,";",3)
if RCIFN=""
QUIT
+4 SET APPTINFO=$GET(^SD(403.5,RCIFN,0))
if APPTINFO=""
QUIT
+5 SET COMM=$PIECE(APPTINFO,U,7)
SET FAST=$PIECE(APPTINFO,U,8)
+6 if FAST]""
SET FAST=$PIECE($PIECE(^DD(403.5,2.6,0),FAST_":",2),";")
+7 SET RPT(3)=" "
+8 if FAST]""
SET RPT(4)="Patient should be "_FAST
+9 SET RPT($SELECT(FAST]"":5,1:4))="Comment: "_COMM
+10 KILL RCIFN,COMM,FAST
+11 QUIT
