- 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 Dec 13, 2024@03:00:51 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