SDEC52A ;ALB/SAT,PC,LAB,KML - VISTA SCHEDULING RPCS ;Apr 22, 2022
;;5.3;Scheduling;**627,658,694,745,774,799,815**;Aug 13, 1993;Build 4
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
RECSET(SDECY,INP) ; SET/EDIT an entry to the RECALL REMINDERS file 403.5
;SD*5.3*745 replace external 'INP...' due to XINDEX issue. Parameters are then rolled into the INP array
;RECSET(SDECY,S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14,S15) external parameter tag is in SDEC
;INPUT:
; INP - Input array
; INP(1) - (optional) IEN pointer to RECALL REMINDERS
; a new entry will be added if null
; INP(2) - (required) DFN Pointer to PATIENT file
; INP(3) - (optional) Accession # (free-text 1-25 characters)
; INP(4) - (optional) COMMENT (free-text 1-80 characters)
; INP(5) - (optional) FAST/NON-FASTING valid values:
; FASTING
; NON-FASTING
; INP(6) - (required) Test/App pointer to RECALL REMINDERS APPT TYPE file 403.51
; INP(7) - (required) Provider - Pointer to RECALL REMINDERS PROVIDERS file 403.54
; INP(8) - (required) Clinic pointer to HOSPITAL LOCATION file
; INP(9) - (optional) Length of Appointment numeric between 10 and 120
; INP(10) - (required) Recall Date in external format (no time)
; INP(11)- (optional) Recall Date (Per patient) in external format (no time)
; INP(12)- (optional) Date Reminder Sent in external format (no time)
; INP(13)- (optional) User Who Entered Recall pointer to NEW PERSON file; default to current user
; INP(14)- (optional) Second Print Date in external format (no time)
; INP(15)- (optional) DATE/TIME Recall Added in external format
; INP(16)- (optional) EAS Tracking Number
;RETURN:
; Successful Return:
; Single Value return in the format "0^<Recall Reminders ien>"
; Caught Exception Return:
; A single entry in the Global Array in the format "-1^<error text>"
; "T00020RETURNCODE^T00100TEXT"
; Unexpected Exception Return:
; Handled by the RPC Broker.
; M errors are trapped by the use of M and Kernel error handling.
; The RPC execution stops and the RPC Broker sends the error generated
; text back to the client.
;
N APPTLEN,CLINIEN,DATE1,DATE,DATE2,DATE3,DAPTDT,DFN,FASTING,ORGDT
N PROVIEN,RECALLIEN,RRAPPTYP,RRNOD,RRPROVIEN,EAS
N SDCOMM,SDFDA,SDIEN,SDMSG,SDRET
N X,Y,%DT
K ^TMP("SDEC52",$J,"RECSET")
; data header
S SDECY="I00020ERRORID^T00030ERRORTEXT"_$C(30)
;
;check IEN of RECALL REMINDERS if passed in (optional)
S RECALLIEN=$G(INP(1))
I RECALLIEN'="" I '$D(^SD(403.5,+RECALLIEN)) S SDECY=SDECY_"-1^Invalid RECALL REMINDERS id."_$C(30,31) Q
I RECALLIEN'="" S RRNOD=$G(^SD(403.5,+RECALLIEN,0))
I RECALLIEN="" S RECALLIEN="+1"
;
;check provider (required)
S RRPROVIEN=$G(INP(7))
I +RRPROVIEN I '$D(^SD(403.54,+RRPROVIEN)) S SDECY=SDECY_"-1^Invalid RECALL REMINDERS PROVIDERS id."_$C(30,31) Q
I '+RRPROVIEN,RECALLIEN="+1" S SDECY=SDECY_"-1^RECALL REMINDERS PROVIDERS id is required."_$C(30,31) Q
;check that user has the correct security key
S SDRET=$$KEY(RRPROVIEN) I SDRET S SDECY=SDECY_SDRET_$C(30,31) Q
;check for valid Patient (required)
S DFN=$G(INP(2))
I +DFN I '$D(^DPT(+DFN,0)) S SDECY=SDECY_"-1^Invalid Patient ID."_$C(30,31) Q
I '+DFN,RECALLIEN="+1" S SDECY=SDECY_"-1^Patient ID is required."_$C(30,31) Q
;check Test/App pointer (required)
S RRAPPTYP=$G(INP(6))
I +RRAPPTYP I '$D(^SD(403.51,+RRAPPTYP)) S SDECY=SDECY_"-1^Invalid RECALL REMINDERS APPT TYPE id."_$C(30,31) Q
I '+RRAPPTYP,RECALLIEN="+1" S SDECY=SDECY_"-1^RECALL REMINDERS APPT TYPE is required."_$C(30,31) Q
;check Clinic (required)
S CLINIEN=$G(INP(8))
I +CLINIEN I '$D(^SC(+CLINIEN)) S SDECY=SDECY_"-1^Invalid Clinic id."_$C(30,31) Q
I '+CLINIEN,RECALLIEN="+1" S SDECY=SDECY_"-1^Clinic ID is required."_$C(30,31) Q
;check Recall Date (required)
S DATE=$G(INP(10))
;
; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
;
S DATE=$$NETTOFM^SDECDATE(DATE,"N","N") I DATE=-1 S SDECY=SDECY_"-1^Invalid Recall Date."_$C(30,31) Q
;I DATE'="" S %DT="" S X=$P(DATE,"@",1) D ^%DT S DATE=Y I Y=-1 S SDECY=SDECY_"-1^Invalid Recall Date."_$C(30,31) Q
I DATE="",RECALLIEN="+1" S SDECY=SDECY_"-1^Recall Date is required."_$C(30,31) Q
;
;check FAST/NON-FASTING (optional)
S FASTING=$G(INP(5))
I FASTING'="" S FASTING=$S($$UP^XLFSTR(FASTING)="FASTING":"f",$$UP^XLFSTR(FASTING)="NON-FASTING":"n",$$UP^XLFSTR(FASTING)="F":"f",$$UP^XLFSTR(FASTING)="N":"n",FASTING="@":"@",1:"")
S INP(5)=FASTING
;check Length of Appointment (optional)
S APPTLEN=$G(INP(9))
I APPTLEN'="" I APPTLEN<10,APPTLEN>120 S APPTLEN=""
;check Recall Date (per Patient) (optional)
S DATE1=$G(INP(11))
;
; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
;
S DATE1=$$NETTOFM^SDECDATE(DATE1,"N","N") I DATE1=-1 S DATE1="" ;
;I DATE1'="" S %DT="" S X=$P(DATE1,"@",1) D ^%DT S DATE1=Y I Y=-1 S DATE1=""
;check date reminder sent (optional)
S DAPTDT=$G(INP(12))
;
; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
;
S DAPTDT=$$NETTOFM^SDECDATE(DAPTDT,"N","N") I DAPTDT=-1 S DAPTDT="" ; changed ORGDT to DAPTDT pwc/ *694
;I DAPTDT'="" S %DT="" S X=$P(DAPTDT,"@",1) D ^%DT S DAPTDT=Y I Y=-1 S ORGDT=""
;check User Who Entered Recall (optional) default to current
S PROVIEN=$G(INP(13))
I (PROVIEN="")!('$D(^VA(200,+PROVIEN))) S PROVIEN=DUZ
;check Second Print date (optional)
S DATE2=$G(INP(14))
;
; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
;
I DATE2'="" S DATE2=$$NETTOFM^SDECDATE(DATE2,"N","N") I DATE2=-1 S DATE2="" ;
;I DATE2="" S %DT="" S X=$P(DATE2,"@",1) D ^%DT S DATE2=Y I Y=-1 S DATE2=""
;check DATE/TIME RECALL ADDED (optional)
S DATE3=$G(INP(15))
;
; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
;
;set EAS Tracking Number
S EAS=$G(INP(16))
I DATE3'="" S DATE3=$$NETTOFM^SDECDATE(DATE3,"N","N") I DATE3=-1 S DATE3="" ; changed TIME requirement to NO in call to NETTOFM^SDECDATE pwc/ *694
;I DATE3'="" S %DT="" S X=$P(DATE3,"@",1) D ^%DT S DATE3=Y I Y=-1 S DATE3=""
I DATE3'="",$G(RRNOD)'="",$P(RRNOD,U,14)'="" S DATE3="" ;only add DATE/TIME RECALL ADDED if it is not already there
;check comment
S (INP(4),SDCOMM)=$TR($G(INP(4)),"^"," ") ;alb/sat 658
;
S SDFDA=$NA(SDFDA(403.5,RECALLIEN_","))
S @SDFDA@(.01)=DFN
S:$G(INP(3))'="" @SDFDA@(2)=$E(INP(3),1,25)
S:SDCOMM'="" @SDFDA@(2.5)=$E(SDCOMM,1,80) ;alb/sat 658 use SDCOMM instead of INP(4)
S:$G(FASTING)'="" @SDFDA@(2.6)=FASTING
S @SDFDA@(3)=RRAPPTYP
S @SDFDA@(4)=RRPROVIEN
S @SDFDA@(4.5)=CLINIEN
S:APPTLEN'="" @SDFDA@(4.7)=APPTLEN
S @SDFDA@(5)=DATE
S:DATE1'="" @SDFDA@(5.5)=DATE1
S:DAPTDT'="" @SDFDA@(6)=DAPTDT
S @SDFDA@(7)=PROVIEN
S:DATE3'="" @SDFDA@(7.5)=DATE3
S:DATE2'="" @SDFDA@(8)=DATE2
S @SDFDA@(100)=EAS
D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
S:RECALLIEN="+1" RECALLIEN=SDIEN(1)
I $D(SDMSG) S SDECY=SDECY_"-1^Error updating RECALL REMINDERS file"_$C(30,31)
I '$D(SDMSG) S SDECY=SDECY_"0^"_$S(RECALLIEN'="":RECALLIEN,1:SDIEN(1))_$C(30,31)
Q
;
RECDSET(SDECY,RECALLIEN,SDRRFTR,SDCOMM) ; DELETE an entry to the RECALL REMINDERS file 403.5
;RECDSET(SDECY,RECALLIEN,SDRRFTR,SDCOMM) external parameter tag is in SDEC
;INPUT:
; INP - Input array
; RECALLIEN - (required) IEN pointer to RECALL REMINDERS
; SDRRFTR - (optional) Recall Disposition used to populate the
; DELETE REASON field in the RECALL REMINDERS
; REMOVED file 403.56 when an entry is removed
; from RECALL REMINDERS file. Valid Values are:
; FAILURE TO RESPOND
; MOVED
; DECEASED
; DOESN'T WANT VA SERVICES
; RECEIVED CARE AT ANOTHER VA
; OTHER
; APPT SCHEDULED
; VET SELF-CANCEL
; SDCOMM - (optional) Text to replace the text in the COMMENT
; Field 2.5 in RECALL REMINDERS prior to the
; delete which moves the data including this
; comment to RECALL REMINDERS REMOVED
;RETURN:
; Successful Return:
; Single Value return in the format "0^<Recall Reminders ien>"
; Caught Exception Return:
; Single Value return in the format "-1^<error text>"
; "T00020ERRORID^T00100ERRORTEXT"
; Unexpected Exception Return:
; Handled by the RPC Broker.
; M errors are trapped by the use of M and Kernel error handling.
; The RPC execution stops and the RPC Broker sends the error generated
; text back to the client.
;
N APPTLEN,DATE1,DATE,DATE2,DAPTDT,DFN,FASTING,PROVIEN,RRAPPTYP,SDFDA,SDIEN,SDMSG,SDRET
; data header
S SDECY="I00020ERRORID^T00030ERRORTEXT"_$C(30)
;
;check IEN of RECALL REMINDERS (required)
I (RECALLIEN="")!('$D(^SD(403.5,+RECALLIEN))) S SDECY=SDECY_"-1^Invalid RECALL REMINDERS id."_$C(30,31) Q
;check disposition (optional)
S SDRRFTR=$G(SDRRFTR)
I SDRRFTR'="" D
.S SDRRFTR=$S(SDRRFTR="FAILURE TO RESPOND":1,SDRRFTR="MOVED":2,SDRRFTR="DECEASED":3,SDRRFTR="DOESN'T WANT VA SERVICES":4,SDRRFTR="RECEIVED CARE AT ANOTHER VA":5,SDRRFTR="OTHER":6,SDRRFTR="APPT SCHEDULED":7,SDRRFTR="VET SELF-CANCEL":8,1:"")
I SDRRFTR="" K SDRRFTR
;
;check provider (required)
;I +RRPROVIEN I '$D(^SD(403.54,+RRPROVIEN)) S SDECY=SDECY_"-1^Invalid RECALL REMINDERS PROVIDERS id."_$C(30,31) Q
;I '+RRPROVIEN S SDECY=SDECY_"-1^RECALL REMINDERS PROVIDERS id is required."_$C(30,31) Q
S RRPROVIEN=$P($G(^SD(403.5,+RECALLIEN,0)),U,5)
I '$D(^SD(403.54,+RRPROVIEN)) S SDECY=SDECY_"-1^Invalid RECALL REMINDERS PROVIDERS defined in RECALL REMINDERS file for id "_RECALLIEN_"."_$C(30,31) Q
;
;verify comment (optional)
S SDCOMM=$G(SDCOMM)
I SDCOMM'="" D ;replace existing comment before calling move/delete
.K SDFDA
.S SDFDA(403.5,RECALLIEN_",",2.5)=$E(SDCOMM,1,80)
.D UPDATE^DIE("","SDFDA")
;
S SDRET=$$RECSETD(RECALLIEN,RRPROVIEN)
S SDECY=SDECY_SDRET_$C(30,31)
Q
;
RECSETD(RECALLIEN,RRPROVIEN) ;delete entry
;INPUT
; RECALLIEN - Pointer to RECALL REMINDERS file
; RRPROVIEN
;RETURN
; "0^<TEXT>" = delete successful
; "-1^<TEXT>" = delete unsuccessful
N RET,SDFDA,SDIEN,SDMSG
S RET=$$KEY(RECALLIEN,RRPROVIEN)
Q:RET RET
S SDFDA=$NA(SDFDA(403.5,RECALLIEN_","))
S @SDFDA@(.01)="@"
D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
I $D(SDMSG) S RET="-1^Error deleting RECALL REMINDERS file"_$C(30,31)
I '$D(SDMSG) S RET="0^"_RECALLIEN
Q RET
;
KEY(RECALLIEN,RRPROVIEN) ;check that user has the correct SECURITY KEY
;INPUT:
; RRPROVIEN - Pointer to RECALL REMINDERS PROVIDERS file 403.54
;RETURN
; 0=User has the correct SECURITY KEY
; "-1^<text>" = User does not have the correct SECURITY KEY
N KEY,KY,RET,SDPRV,SDFLAG
S RET="-1^THE PROVIDER ASSIGNED TO THIS RECALL REMINDER IS ASSIGNED A SECURITY KEY WHICH YOU DO NOT HAVE. PLEASE CONTACT YOUR RECALL COORDINATOR."
S (SDPRV,KEY,SDFLAG)="" S SDPRV=$P($G(^SD(403.5,+RECALLIEN,0)),U,5) D
.I SDPRV="" S RET=0
.I SDPRV'="" S KEY=$P($G(^SD(403.54,SDPRV,0)),U,7) D
..I KEY="" S RET=0 Q
..N VALUE
..S VALUE=$$LKUP^XPDKEY(KEY) K KY D OWNSKEY^XUSRB(.KY,VALUE,DUZ) ;ICR 1367 and ICR 3277
..I $G(KY(0))'=0 S RET=0
Q RET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC52A 11649 printed Apr 09, 2024@22:01:56 Page 2
SDEC52A ;ALB/SAT,PC,LAB,KML - VISTA SCHEDULING RPCS ;Apr 22, 2022
+1 ;;5.3;Scheduling;**627,658,694,745,774,799,815**;Aug 13, 1993;Build 4
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
RECSET(SDECY,INP) ; SET/EDIT an entry to the RECALL REMINDERS file 403.5
+1 ;SD*5.3*745 replace external 'INP...' due to XINDEX issue. Parameters are then rolled into the INP array
+2 ;RECSET(SDECY,S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14,S15) external parameter tag is in SDEC
+3 ;INPUT:
+4 ; INP - Input array
+5 ; INP(1) - (optional) IEN pointer to RECALL REMINDERS
+6 ; a new entry will be added if null
+7 ; INP(2) - (required) DFN Pointer to PATIENT file
+8 ; INP(3) - (optional) Accession # (free-text 1-25 characters)
+9 ; INP(4) - (optional) COMMENT (free-text 1-80 characters)
+10 ; INP(5) - (optional) FAST/NON-FASTING valid values:
+11 ; FASTING
+12 ; NON-FASTING
+13 ; INP(6) - (required) Test/App pointer to RECALL REMINDERS APPT TYPE file 403.51
+14 ; INP(7) - (required) Provider - Pointer to RECALL REMINDERS PROVIDERS file 403.54
+15 ; INP(8) - (required) Clinic pointer to HOSPITAL LOCATION file
+16 ; INP(9) - (optional) Length of Appointment numeric between 10 and 120
+17 ; INP(10) - (required) Recall Date in external format (no time)
+18 ; INP(11)- (optional) Recall Date (Per patient) in external format (no time)
+19 ; INP(12)- (optional) Date Reminder Sent in external format (no time)
+20 ; INP(13)- (optional) User Who Entered Recall pointer to NEW PERSON file; default to current user
+21 ; INP(14)- (optional) Second Print Date in external format (no time)
+22 ; INP(15)- (optional) DATE/TIME Recall Added in external format
+23 ; INP(16)- (optional) EAS Tracking Number
+24 ;RETURN:
+25 ; Successful Return:
+26 ; Single Value return in the format "0^<Recall Reminders ien>"
+27 ; Caught Exception Return:
+28 ; A single entry in the Global Array in the format "-1^<error text>"
+29 ; "T00020RETURNCODE^T00100TEXT"
+30 ; Unexpected Exception Return:
+31 ; Handled by the RPC Broker.
+32 ; M errors are trapped by the use of M and Kernel error handling.
+33 ; The RPC execution stops and the RPC Broker sends the error generated
+34 ; text back to the client.
+35 ;
+36 NEW APPTLEN,CLINIEN,DATE1,DATE,DATE2,DATE3,DAPTDT,DFN,FASTING,ORGDT
+37 NEW PROVIEN,RECALLIEN,RRAPPTYP,RRNOD,RRPROVIEN,EAS
+38 NEW SDCOMM,SDFDA,SDIEN,SDMSG,SDRET
+39 NEW X,Y,%DT
+40 KILL ^TMP("SDEC52",$JOB,"RECSET")
+41 ; data header
+42 SET SDECY="I00020ERRORID^T00030ERRORTEXT"_$CHAR(30)
+43 ;
+44 ;check IEN of RECALL REMINDERS if passed in (optional)
+45 SET RECALLIEN=$GET(INP(1))
+46 IF RECALLIEN'=""
IF '$DATA(^SD(403.5,+RECALLIEN))
SET SDECY=SDECY_"-1^Invalid RECALL REMINDERS id."_$CHAR(30,31)
QUIT
+47 IF RECALLIEN'=""
SET RRNOD=$GET(^SD(403.5,+RECALLIEN,0))
+48 IF RECALLIEN=""
SET RECALLIEN="+1"
+49 ;
+50 ;check provider (required)
+51 SET RRPROVIEN=$GET(INP(7))
+52 IF +RRPROVIEN
IF '$DATA(^SD(403.54,+RRPROVIEN))
SET SDECY=SDECY_"-1^Invalid RECALL REMINDERS PROVIDERS id."_$CHAR(30,31)
QUIT
+53 IF '+RRPROVIEN
IF RECALLIEN="+1"
SET SDECY=SDECY_"-1^RECALL REMINDERS PROVIDERS id is required."_$CHAR(30,31)
QUIT
+54 ;check that user has the correct security key
+55 SET SDRET=$$KEY(RRPROVIEN)
IF SDRET
SET SDECY=SDECY_SDRET_$CHAR(30,31)
QUIT
+56 ;check for valid Patient (required)
+57 SET DFN=$GET(INP(2))
+58 IF +DFN
IF '$DATA(^DPT(+DFN,0))
SET SDECY=SDECY_"-1^Invalid Patient ID."_$CHAR(30,31)
QUIT
+59 IF '+DFN
IF RECALLIEN="+1"
SET SDECY=SDECY_"-1^Patient ID is required."_$CHAR(30,31)
QUIT
+60 ;check Test/App pointer (required)
+61 SET RRAPPTYP=$GET(INP(6))
+62 IF +RRAPPTYP
IF '$DATA(^SD(403.51,+RRAPPTYP))
SET SDECY=SDECY_"-1^Invalid RECALL REMINDERS APPT TYPE id."_$CHAR(30,31)
QUIT
+63 IF '+RRAPPTYP
IF RECALLIEN="+1"
SET SDECY=SDECY_"-1^RECALL REMINDERS APPT TYPE is required."_$CHAR(30,31)
QUIT
+64 ;check Clinic (required)
+65 SET CLINIEN=$GET(INP(8))
+66 IF +CLINIEN
IF '$DATA(^SC(+CLINIEN))
SET SDECY=SDECY_"-1^Invalid Clinic id."_$CHAR(30,31)
QUIT
+67 IF '+CLINIEN
IF RECALLIEN="+1"
SET SDECY=SDECY_"-1^Clinic ID is required."_$CHAR(30,31)
QUIT
+68 ;check Recall Date (required)
+69 SET DATE=$GET(INP(10))
+70 ;
+71 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+72 ;
+73 SET DATE=$$NETTOFM^SDECDATE(DATE,"N","N")
IF DATE=-1
SET SDECY=SDECY_"-1^Invalid Recall Date."_$CHAR(30,31)
QUIT
+74 ;I DATE'="" S %DT="" S X=$P(DATE,"@",1) D ^%DT S DATE=Y I Y=-1 S SDECY=SDECY_"-1^Invalid Recall Date."_$C(30,31) Q
+75 IF DATE=""
IF RECALLIEN="+1"
SET SDECY=SDECY_"-1^Recall Date is required."_$CHAR(30,31)
QUIT
+76 ;
+77 ;check FAST/NON-FASTING (optional)
+78 SET FASTING=$GET(INP(5))
+79 IF FASTING'=""
SET FASTING=$SELECT($$UP^XLFSTR(FASTING)="FASTING":"f",$$UP^XLFSTR(FASTING)="NON-FASTING":"n",$$UP^XLFSTR(FASTING)="F":"f",$$UP^XLFSTR(FASTING)="N":"n",FASTING="@":"@",1:"")
+80 SET INP(5)=FASTING
+81 ;check Length of Appointment (optional)
+82 SET APPTLEN=$GET(INP(9))
+83 IF APPTLEN'=""
IF APPTLEN<10
IF APPTLEN>120
SET APPTLEN=""
+84 ;check Recall Date (per Patient) (optional)
+85 SET DATE1=$GET(INP(11))
+86 ;
+87 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+88 ;
+89 ;
SET DATE1=$$NETTOFM^SDECDATE(DATE1,"N","N")
IF DATE1=-1
SET DATE1=""
+90 ;I DATE1'="" S %DT="" S X=$P(DATE1,"@",1) D ^%DT S DATE1=Y I Y=-1 S DATE1=""
+91 ;check date reminder sent (optional)
+92 SET DAPTDT=$GET(INP(12))
+93 ;
+94 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+95 ;
+96 ; changed ORGDT to DAPTDT pwc/ *694
SET DAPTDT=$$NETTOFM^SDECDATE(DAPTDT,"N","N")
IF DAPTDT=-1
SET DAPTDT=""
+97 ;I DAPTDT'="" S %DT="" S X=$P(DAPTDT,"@",1) D ^%DT S DAPTDT=Y I Y=-1 S ORGDT=""
+98 ;check User Who Entered Recall (optional) default to current
+99 SET PROVIEN=$GET(INP(13))
+100 IF (PROVIEN="")!('$DATA(^VA(200,+PROVIEN)))
SET PROVIEN=DUZ
+101 ;check Second Print date (optional)
+102 SET DATE2=$GET(INP(14))
+103 ;
+104 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+105 ;
+106 ;
IF DATE2'=""
SET DATE2=$$NETTOFM^SDECDATE(DATE2,"N","N")
IF DATE2=-1
SET DATE2=""
+107 ;I DATE2="" S %DT="" S X=$P(DATE2,"@",1) D ^%DT S DATE2=Y I Y=-1 S DATE2=""
+108 ;check DATE/TIME RECALL ADDED (optional)
+109 SET DATE3=$GET(INP(15))
+110 ;
+111 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
+112 ;
+113 ;set EAS Tracking Number
+114 SET EAS=$GET(INP(16))
+115 ; changed TIME requirement to NO in call to NETTOFM^SDECDATE pwc/ *694
IF DATE3'=""
SET DATE3=$$NETTOFM^SDECDATE(DATE3,"N","N")
IF DATE3=-1
SET DATE3=""
+116 ;I DATE3'="" S %DT="" S X=$P(DATE3,"@",1) D ^%DT S DATE3=Y I Y=-1 S DATE3=""
+117 ;only add DATE/TIME RECALL ADDED if it is not already there
IF DATE3'=""
IF $GET(RRNOD)'=""
IF $PIECE(RRNOD,U,14)'=""
SET DATE3=""
+118 ;check comment
+119 ;alb/sat 658
SET (INP(4),SDCOMM)=$TRANSLATE($GET(INP(4)),"^"," ")
+120 ;
+121 SET SDFDA=$NAME(SDFDA(403.5,RECALLIEN_","))
+122 SET @SDFDA@(.01)=DFN
+123 if $GET(INP(3))'=""
SET @SDFDA@(2)=$EXTRACT(INP(3),1,25)
+124 ;alb/sat 658 use SDCOMM instead of INP(4)
if SDCOMM'=""
SET @SDFDA@(2.5)=$EXTRACT(SDCOMM,1,80)
+125 if $GET(FASTING)'=""
SET @SDFDA@(2.6)=FASTING
+126 SET @SDFDA@(3)=RRAPPTYP
+127 SET @SDFDA@(4)=RRPROVIEN
+128 SET @SDFDA@(4.5)=CLINIEN
+129 if APPTLEN'=""
SET @SDFDA@(4.7)=APPTLEN
+130 SET @SDFDA@(5)=DATE
+131 if DATE1'=""
SET @SDFDA@(5.5)=DATE1
+132 if DAPTDT'=""
SET @SDFDA@(6)=DAPTDT
+133 SET @SDFDA@(7)=PROVIEN
+134 if DATE3'=""
SET @SDFDA@(7.5)=DATE3
+135 if DATE2'=""
SET @SDFDA@(8)=DATE2
+136 SET @SDFDA@(100)=EAS
+137 DO UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
+138 if RECALLIEN="+1"
SET RECALLIEN=SDIEN(1)
+139 IF $DATA(SDMSG)
SET SDECY=SDECY_"-1^Error updating RECALL REMINDERS file"_$CHAR(30,31)
+140 IF '$DATA(SDMSG)
SET SDECY=SDECY_"0^"_$SELECT(RECALLIEN'="":RECALLIEN,1:SDIEN(1))_$CHAR(30,31)
+141 QUIT
+142 ;
RECDSET(SDECY,RECALLIEN,SDRRFTR,SDCOMM) ; DELETE an entry to the RECALL REMINDERS file 403.5
+1 ;RECDSET(SDECY,RECALLIEN,SDRRFTR,SDCOMM) external parameter tag is in SDEC
+2 ;INPUT:
+3 ; INP - Input array
+4 ; RECALLIEN - (required) IEN pointer to RECALL REMINDERS
+5 ; SDRRFTR - (optional) Recall Disposition used to populate the
+6 ; DELETE REASON field in the RECALL REMINDERS
+7 ; REMOVED file 403.56 when an entry is removed
+8 ; from RECALL REMINDERS file. Valid Values are:
+9 ; FAILURE TO RESPOND
+10 ; MOVED
+11 ; DECEASED
+12 ; DOESN'T WANT VA SERVICES
+13 ; RECEIVED CARE AT ANOTHER VA
+14 ; OTHER
+15 ; APPT SCHEDULED
+16 ; VET SELF-CANCEL
+17 ; SDCOMM - (optional) Text to replace the text in the COMMENT
+18 ; Field 2.5 in RECALL REMINDERS prior to the
+19 ; delete which moves the data including this
+20 ; comment to RECALL REMINDERS REMOVED
+21 ;RETURN:
+22 ; Successful Return:
+23 ; Single Value return in the format "0^<Recall Reminders ien>"
+24 ; Caught Exception Return:
+25 ; Single Value return in the format "-1^<error text>"
+26 ; "T00020ERRORID^T00100ERRORTEXT"
+27 ; Unexpected Exception Return:
+28 ; Handled by the RPC Broker.
+29 ; M errors are trapped by the use of M and Kernel error handling.
+30 ; The RPC execution stops and the RPC Broker sends the error generated
+31 ; text back to the client.
+32 ;
+33 NEW APPTLEN,DATE1,DATE,DATE2,DAPTDT,DFN,FASTING,PROVIEN,RRAPPTYP,SDFDA,SDIEN,SDMSG,SDRET
+34 ; data header
+35 SET SDECY="I00020ERRORID^T00030ERRORTEXT"_$CHAR(30)
+36 ;
+37 ;check IEN of RECALL REMINDERS (required)
+38 IF (RECALLIEN="")!('$DATA(^SD(403.5,+RECALLIEN)))
SET SDECY=SDECY_"-1^Invalid RECALL REMINDERS id."_$CHAR(30,31)
QUIT
+39 ;check disposition (optional)
+40 SET SDRRFTR=$GET(SDRRFTR)
+41 IF SDRRFTR'=""
Begin DoDot:1
+42 SET SDRRFTR=$SELECT(SDRRFTR="FAILURE TO RESPOND":1,SDRRFTR="MOVED":2,SDRRFTR="DECEASED":3,SDRRFTR="DOESN'T WANT VA SERVICES":4,SDRRFTR="RECEIVED CARE AT ANOTHER VA":5,SDRRFTR="OTHER":6,SDRRFTR="APPT SCHEDULED":7,SDRRFTR="VET SELF-CANCEL
":8,1:"")
End DoDot:1
+43 IF SDRRFTR=""
KILL SDRRFTR
+44 ;
+45 ;check provider (required)
+46 ;I +RRPROVIEN I '$D(^SD(403.54,+RRPROVIEN)) S SDECY=SDECY_"-1^Invalid RECALL REMINDERS PROVIDERS id."_$C(30,31) Q
+47 ;I '+RRPROVIEN S SDECY=SDECY_"-1^RECALL REMINDERS PROVIDERS id is required."_$C(30,31) Q
+48 SET RRPROVIEN=$PIECE($GET(^SD(403.5,+RECALLIEN,0)),U,5)
+49 IF '$DATA(^SD(403.54,+RRPROVIEN))
SET SDECY=SDECY_"-1^Invalid RECALL REMINDERS PROVIDERS defined in RECALL REMINDERS file for id "_RECALLIEN_"."_$CHAR(30,31)
QUIT
+50 ;
+51 ;verify comment (optional)
+52 SET SDCOMM=$GET(SDCOMM)
+53 ;replace existing comment before calling move/delete
IF SDCOMM'=""
Begin DoDot:1
+54 KILL SDFDA
+55 SET SDFDA(403.5,RECALLIEN_",",2.5)=$EXTRACT(SDCOMM,1,80)
+56 DO UPDATE^DIE("","SDFDA")
End DoDot:1
+57 ;
+58 SET SDRET=$$RECSETD(RECALLIEN,RRPROVIEN)
+59 SET SDECY=SDECY_SDRET_$CHAR(30,31)
+60 QUIT
+61 ;
RECSETD(RECALLIEN,RRPROVIEN) ;delete entry
+1 ;INPUT
+2 ; RECALLIEN - Pointer to RECALL REMINDERS file
+3 ; RRPROVIEN
+4 ;RETURN
+5 ; "0^<TEXT>" = delete successful
+6 ; "-1^<TEXT>" = delete unsuccessful
+7 NEW RET,SDFDA,SDIEN,SDMSG
+8 SET RET=$$KEY(RECALLIEN,RRPROVIEN)
+9 if RET
QUIT RET
+10 SET SDFDA=$NAME(SDFDA(403.5,RECALLIEN_","))
+11 SET @SDFDA@(.01)="@"
+12 DO UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
+13 IF $DATA(SDMSG)
SET RET="-1^Error deleting RECALL REMINDERS file"_$CHAR(30,31)
+14 IF '$DATA(SDMSG)
SET RET="0^"_RECALLIEN
+15 QUIT RET
+16 ;
KEY(RECALLIEN,RRPROVIEN) ;check that user has the correct SECURITY KEY
+1 ;INPUT:
+2 ; RRPROVIEN - Pointer to RECALL REMINDERS PROVIDERS file 403.54
+3 ;RETURN
+4 ; 0=User has the correct SECURITY KEY
+5 ; "-1^<text>" = User does not have the correct SECURITY KEY
+6 NEW KEY,KY,RET,SDPRV,SDFLAG
+7 SET RET="-1^THE PROVIDER ASSIGNED TO THIS RECALL REMINDER IS ASSIGNED A SECURITY KEY WHICH YOU DO NOT HAVE. PLEASE CONTACT YOUR RECALL COORDINATOR."
+8 SET (SDPRV,KEY,SDFLAG)=""
SET SDPRV=$PIECE($GET(^SD(403.5,+RECALLIEN,0)),U,5)
Begin DoDot:1
+9 IF SDPRV=""
SET RET=0
+10 IF SDPRV'=""
SET KEY=$PIECE($GET(^SD(403.54,SDPRV,0)),U,7)
Begin DoDot:2
+11 IF KEY=""
SET RET=0
QUIT
+12 NEW VALUE
+13 ;ICR 1367 and ICR 3277
SET VALUE=$$LKUP^XPDKEY(KEY)
KILL KY
DO OWNSKEY^XUSRB(.KY,VALUE,DUZ)
+14 IF $GET(KY(0))'=0
SET RET=0
End DoDot:2
End DoDot:1
+15 QUIT RET
