SDESUPDRECREQ ;ALB/LAB,KML,MGD - ;July 19, 2022
;;5.3;Scheduling;**803,805,809,820**;Aug 13, 1993;Build 10
;;Per VHA Directive 6402, this routine should not be modified
;
; Documented API's and Integration Agreements
; -------------------------------------------
; Reference to $$LKUP^XPDKEY is supported by IA #1367
; Reference to OWNSKEY^XUSRB is supported by IA #3277
;
;INPUT:
; RECALLIEN - sent for UPDATE of RECALL REQUEST only(Required for Update) IEN pointer to RECALL REMINDERS
; DFN - (required) DFN Pointer to PATIENT file
; ACCNO - (optional) Accession # (free-text 1-25 characters)
; SDCMT - (optional) COMMENT (free-text 1-80 characters)
; FASTING - (required) FAST/NON-FASTING valid values: FASTING,NON-FASTING,NONE
; APPTP - (required) Test/App pointer to RECALL REMINDERS APPT TYPE file 403.51
; RRPROVIEN - (required) Provider - Pointer to RECALL REMINDERS PROVIDERS file 403.54
; CLINIEN - (required) Clinic pointer to HOSPITAL LOCATION file
; APPTLEN - (optional) Length of Appointment numeric between 10 and 120
; DATE - (required) Recall Date in ISO8601 format (no time). e.g., CCYY-MM-DD
; RECPPDT- (optional) Recall Date (Per patient) in ISO8601 format (no time) e.g., CCYY-MM-DD
; DAPTDT- (optional) Date Reminder Sent in ISO8601 format (no time) e.g., CCYY-MM-DD
; USERIEN- (optional) User Who Entered Recall pointer to NEW PERSON file; default to current user
; SECPDT- (optional) Second Print Date in ISO8601 format (no time) e.g., CCYY-MM-DD
; SDENTDT - (optional) Date recall entered in ISO8601 format e.g., CCYY-MM-DD)
; EAS- (optional) EAS Tracking Number
;
;RETURN:
Q
;
CREATERECREQ(RETN,DFN,ACCNO,SDCMT,FASTING,APPTP,RRPROVIEN,CLINIEN,APPTLEN,DATE,RECPPDT,DAPTDT,USERIEN,SECPDT,SDENTDT,EAS) ;CREATE recall request
N POP,SDRECREQ,RECALLIEN,SDCREATE,SDFDA,SDMSG,SDIEN
S RECALLIEN="+1",SDCREATE=1
S POP=0
D VALIDATE
I POP D BLDJSON
Q:POP
D DATACONV
D BLDREC
D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
I $D(SDMSG) S NUM=134 D CALLERROR,BLDJSON Q
S SDRECREQ("RecallReqCreate","IEN")=SDIEN(1)
D BLDJSON
Q
;
UPDRECALLREQ(RETN,RECALLIEN,DFN,ACCNO,SDCMT,FASTING,APPTP,RRPROVIEN,CLINIEN,APPTLEN,DATE,RECPPDT,DAPTDT,USERIEN,SECPDT,EAS) ;update recall request
N POP,SDRECREQ,SDFDA,SDMSG,SDIEN
S POP=0,SDCREATE=0
D VALIDATE
I POP D BLDJSON
Q:POP
D DATACONV
D BLDREC
D FILE^DIE(,"SDFDA","SDMSG")
I $D(SDMSG) S NUM=134 D CALLERROR,BLDJSON Q
S SDRECREQ("RecallReqEdit","IEN")=RECALLIEN
D BLDJSON
Q
;
DATACONV ;make any data conversion changes
S APPTLEN=$G(APPTLEN) I APPTLEN'="" S:((+APPTLEN<10)!(+APPTLEN>120)) APPTLEN=""
S RECPPDT=$G(RECPPDT) S RECPPDT=$$ISOTFM^SDAMUTDT(RECPPDT) I RECPPDT=-1 S RECPPDT="" ;VSE-2396
S DAPTDT=$G(DAPTDT) S DAPTDT=$$ISOTFM^SDAMUTDT(DAPTDT) I DAPTDT=-1 S DAPTDT="" ;VSE-2396
S USERIEN=$G(USERIEN) I (USERIEN="")!('$D(^VA(200,+USERIEN))) S USERIEN=DUZ
S SECPDT=$G(SECPDT) I SECPDT'="" S SECPDT=$$ISOTFM^SDAMUTDT(SECPDT) I SECPDT=-1 S SECPDT="" ;;VSE-2396
S EAS=$G(EAS)
S SDCMT=$TR($G(SDCMT),"^"," ")
Q
;
VALIDATE ;validate input parameters
N NUM
I $G(RECALLIEN)="" S POP=1,NUM=16 D CALLERROR Q
I (RECALLIEN'="+1")&('$D(^SD(403.5,+RECALLIEN))) S POP=1,NUM=17 D CALLERROR Q
I '+$G(DFN) S POP=1,NUM=1 D CALLERROR Q
I '$D(^DPT(+DFN,0)) S POP=1,NUM=2 D CALLERROR Q
S FASTING=$G(FASTING)
I FASTING="" S POP=1,NUM=141 D CALLERROR Q
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:138)
I FASTING=138 S POP=1,NUM=138 D CALLERROR
Q:POP
S APPTP=$G(APPTP) I '(+APPTP) s POP=1,NUM=139 D CALLERROR Q
I '$D(^SD(403.51,+APPTP)) S POP=1,NUM=132 D CALLERROR Q
;check provider (required)
I '+$G(RRPROVIEN) S POP=1,NUM=137 D CALLERROR Q
I +RRPROVIEN I '$D(^SD(403.54,+RRPROVIEN)) S POP=1,NUM=131 D CALLERROR Q
;check that user has the correct security key
S NUM=$$KEY(RECALLIEN) I NUM S POP=1 D CALLERROR Q
;check Clinic (required)
S CLINIEN=$G(CLINIEN)
I '+CLINIEN S POP=1,NUM=18 D CALLERROR Q
I +CLINIEN I '$D(^SC(+CLINIEN)) S POP=1,NUM=19 D CALLERROR Q
;check Recall Date (required)
S DATE=$G(DATE) I DATE="" S POP=1,NUM=140 D CALLERROR Q
S DATE=$$ISOTFM^SDAMUTDT(DATE) I DATE=-1 S POP=1,NUM=133 D CALLERROR Q ;VSE-2396
S SDENTDT=$G(SDENTDT)
I (SDCREATE)&($G(SDENTDT)'="") S SDENTDT=$$ISOTFM^SDAMUTDT(SDENTDT) ;VSE-2396
I (SDENTDT=-1)!(SDENTDT="") S SDENTDT=DT ;
;validate EAS
I $L(EAS) S EAS=$$EASVALIDATE^SDESUTIL(EAS)
I EAS=-1 S POP=1,NUM=142 D CALLERROR
Q
;
CALLERROR ;calls json error logic if error encountered
D ERRLOG^SDESJSON(.SDRECREQ,NUM)
Q
;
BLDREC ;build and file record
S SDFDA=$NA(SDFDA(403.5,RECALLIEN_",")) ;recall
S SDFDA(403.5,RECALLIEN_",",.01)=DFN
S:$G(ACCNO)'="" SDFDA(403.5,RECALLIEN_",",2)=$E(ACCNO,1,25)
S:SDCMT'="" SDFDA(403.5,RECALLIEN_",",2.5)=$E(SDCMT,1,80)
S SDFDA(403.5,RECALLIEN_",",2.6)=FASTING
S SDFDA(403.5,RECALLIEN_",",3)=APPTP
S SDFDA(403.5,RECALLIEN_",",4)=RRPROVIEN
S SDFDA(403.5,RECALLIEN_",",4.5)=CLINIEN
S:APPTLEN'="" SDFDA(403.5,RECALLIEN_",",4.7)=APPTLEN
S SDFDA(403.5,RECALLIEN_",",5)=DATE
S:RECPPDT'="" SDFDA(403.5,RECALLIEN_",",5.5)=RECPPDT
S:DAPTDT'="" SDFDA(403.5,RECALLIEN_",",6)=DAPTDT
S SDFDA(403.5,RECALLIEN_",",7)=USERIEN
S:SDCREATE SDFDA(403.5,RECALLIEN_",",7.5)=SDENTDT ;only add if creating new record, cannot edit
S:SECPDT'="" SDFDA(403.5,RECALLIEN_",",8)=SECPDT
S:EAS'="" SDFDA(403.5,RECALLIEN_",",100)=EAS
Q
;
BLDJSON ;Convert data to JSON
N JSONERR
S JSONERR=""
D ENCODE^SDESJSON(.SDRECREQ,.RETN,.JSONERR)
Q
;
KEY(RECALLIEN) ;check that user has the correct SECURITY KEY
;INPUT:
; RECALLIEN - Pointer to RECALL REMINDERS file 403.5
;RETURN
; 0=User has the correct SECURITY KEY
; 135=error number - user does not have correct security keys
N KEY,KY,RET,SDPRV,SDFLAG
S RET=135
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)
..I $G(KY(0))'=0 S RET=0
Q RET
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESUPDRECREQ 6288 printed Oct 16, 2024@18:58:13 Page 2
SDESUPDRECREQ ;ALB/LAB,KML,MGD - ;July 19, 2022
+1 ;;5.3;Scheduling;**803,805,809,820**;Aug 13, 1993;Build 10
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Documented API's and Integration Agreements
+5 ; -------------------------------------------
+6 ; Reference to $$LKUP^XPDKEY is supported by IA #1367
+7 ; Reference to OWNSKEY^XUSRB is supported by IA #3277
+8 ;
+9 ;INPUT:
+10 ; RECALLIEN - sent for UPDATE of RECALL REQUEST only(Required for Update) IEN pointer to RECALL REMINDERS
+11 ; DFN - (required) DFN Pointer to PATIENT file
+12 ; ACCNO - (optional) Accession # (free-text 1-25 characters)
+13 ; SDCMT - (optional) COMMENT (free-text 1-80 characters)
+14 ; FASTING - (required) FAST/NON-FASTING valid values: FASTING,NON-FASTING,NONE
+15 ; APPTP - (required) Test/App pointer to RECALL REMINDERS APPT TYPE file 403.51
+16 ; RRPROVIEN - (required) Provider - Pointer to RECALL REMINDERS PROVIDERS file 403.54
+17 ; CLINIEN - (required) Clinic pointer to HOSPITAL LOCATION file
+18 ; APPTLEN - (optional) Length of Appointment numeric between 10 and 120
+19 ; DATE - (required) Recall Date in ISO8601 format (no time). e.g., CCYY-MM-DD
+20 ; RECPPDT- (optional) Recall Date (Per patient) in ISO8601 format (no time) e.g., CCYY-MM-DD
+21 ; DAPTDT- (optional) Date Reminder Sent in ISO8601 format (no time) e.g., CCYY-MM-DD
+22 ; USERIEN- (optional) User Who Entered Recall pointer to NEW PERSON file; default to current user
+23 ; SECPDT- (optional) Second Print Date in ISO8601 format (no time) e.g., CCYY-MM-DD
+24 ; SDENTDT - (optional) Date recall entered in ISO8601 format e.g., CCYY-MM-DD)
+25 ; EAS- (optional) EAS Tracking Number
+26 ;
+27 ;RETURN:
+28 QUIT
+29 ;
CREATERECREQ(RETN,DFN,ACCNO,SDCMT,FASTING,APPTP,RRPROVIEN,CLINIEN,APPTLEN,DATE,RECPPDT,DAPTDT,USERIEN,SECPDT,SDENTDT,EAS) ;CREATE recall request
+1 NEW POP,SDRECREQ,RECALLIEN,SDCREATE,SDFDA,SDMSG,SDIEN
+2 SET RECALLIEN="+1"
SET SDCREATE=1
+3 SET POP=0
+4 DO VALIDATE
+5 IF POP
DO BLDJSON
+6 if POP
QUIT
+7 DO DATACONV
+8 DO BLDREC
+9 DO UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
+10 IF $DATA(SDMSG)
SET NUM=134
DO CALLERROR
DO BLDJSON
QUIT
+11 SET SDRECREQ("RecallReqCreate","IEN")=SDIEN(1)
+12 DO BLDJSON
+13 QUIT
+14 ;
UPDRECALLREQ(RETN,RECALLIEN,DFN,ACCNO,SDCMT,FASTING,APPTP,RRPROVIEN,CLINIEN,APPTLEN,DATE,RECPPDT,DAPTDT,USERIEN,SECPDT,EAS) ;update recall request
+1 NEW POP,SDRECREQ,SDFDA,SDMSG,SDIEN
+2 SET POP=0
SET SDCREATE=0
+3 DO VALIDATE
+4 IF POP
DO BLDJSON
+5 if POP
QUIT
+6 DO DATACONV
+7 DO BLDREC
+8 DO FILE^DIE(,"SDFDA","SDMSG")
+9 IF $DATA(SDMSG)
SET NUM=134
DO CALLERROR
DO BLDJSON
QUIT
+10 SET SDRECREQ("RecallReqEdit","IEN")=RECALLIEN
+11 DO BLDJSON
+12 QUIT
+13 ;
DATACONV ;make any data conversion changes
+1 SET APPTLEN=$GET(APPTLEN)
IF APPTLEN'=""
if ((+APPTLEN<10)!(+APPTLEN>120))
SET APPTLEN=""
+2 ;VSE-2396
SET RECPPDT=$GET(RECPPDT)
SET RECPPDT=$$ISOTFM^SDAMUTDT(RECPPDT)
IF RECPPDT=-1
SET RECPPDT=""
+3 ;VSE-2396
SET DAPTDT=$GET(DAPTDT)
SET DAPTDT=$$ISOTFM^SDAMUTDT(DAPTDT)
IF DAPTDT=-1
SET DAPTDT=""
+4 SET USERIEN=$GET(USERIEN)
IF (USERIEN="")!('$DATA(^VA(200,+USERIEN)))
SET USERIEN=DUZ
+5 ;;VSE-2396
SET SECPDT=$GET(SECPDT)
IF SECPDT'=""
SET SECPDT=$$ISOTFM^SDAMUTDT(SECPDT)
IF SECPDT=-1
SET SECPDT=""
+6 SET EAS=$GET(EAS)
+7 SET SDCMT=$TRANSLATE($GET(SDCMT),"^"," ")
+8 QUIT
+9 ;
VALIDATE ;validate input parameters
+1 NEW NUM
+2 IF $GET(RECALLIEN)=""
SET POP=1
SET NUM=16
DO CALLERROR
QUIT
+3 IF (RECALLIEN'="+1")&('$DATA(^SD(403.5,+RECALLIEN)))
SET POP=1
SET NUM=17
DO CALLERROR
QUIT
+4 IF '+$GET(DFN)
SET POP=1
SET NUM=1
DO CALLERROR
QUIT
+5 IF '$DATA(^DPT(+DFN,0))
SET POP=1
SET NUM=2
DO CALLERROR
QUIT
+6 SET FASTING=$GET(FASTING)
+7 IF FASTING=""
SET POP=1
SET NUM=141
DO CALLERROR
QUIT
+8 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:138)
+9 IF FASTING=138
SET POP=1
SET NUM=138
DO CALLERROR
+10 if POP
QUIT
+11 SET APPTP=$GET(APPTP)
IF '(+APPTP)
SET POP=1
SET NUM=139
DO CALLERROR
QUIT
+12 IF '$DATA(^SD(403.51,+APPTP))
SET POP=1
SET NUM=132
DO CALLERROR
QUIT
+13 ;check provider (required)
+14 IF '+$GET(RRPROVIEN)
SET POP=1
SET NUM=137
DO CALLERROR
QUIT
+15 IF +RRPROVIEN
IF '$DATA(^SD(403.54,+RRPROVIEN))
SET POP=1
SET NUM=131
DO CALLERROR
QUIT
+16 ;check that user has the correct security key
+17 SET NUM=$$KEY(RECALLIEN)
IF NUM
SET POP=1
DO CALLERROR
QUIT
+18 ;check Clinic (required)
+19 SET CLINIEN=$GET(CLINIEN)
+20 IF '+CLINIEN
SET POP=1
SET NUM=18
DO CALLERROR
QUIT
+21 IF +CLINIEN
IF '$DATA(^SC(+CLINIEN))
SET POP=1
SET NUM=19
DO CALLERROR
QUIT
+22 ;check Recall Date (required)
+23 SET DATE=$GET(DATE)
IF DATE=""
SET POP=1
SET NUM=140
DO CALLERROR
QUIT
+24 ;VSE-2396
SET DATE=$$ISOTFM^SDAMUTDT(DATE)
IF DATE=-1
SET POP=1
SET NUM=133
DO CALLERROR
QUIT
+25 SET SDENTDT=$GET(SDENTDT)
+26 ;VSE-2396
IF (SDCREATE)&($GET(SDENTDT)'="")
SET SDENTDT=$$ISOTFM^SDAMUTDT(SDENTDT)
+27 ;
IF (SDENTDT=-1)!(SDENTDT="")
SET SDENTDT=DT
+28 ;validate EAS
+29 IF $LENGTH(EAS)
SET EAS=$$EASVALIDATE^SDESUTIL(EAS)
+30 IF EAS=-1
SET POP=1
SET NUM=142
DO CALLERROR
+31 QUIT
+32 ;
CALLERROR ;calls json error logic if error encountered
+1 DO ERRLOG^SDESJSON(.SDRECREQ,NUM)
+2 QUIT
+3 ;
BLDREC ;build and file record
+1 ;recall
SET SDFDA=$NAME(SDFDA(403.5,RECALLIEN_","))
+2 SET SDFDA(403.5,RECALLIEN_",",.01)=DFN
+3 if $GET(ACCNO)'=""
SET SDFDA(403.5,RECALLIEN_",",2)=$EXTRACT(ACCNO,1,25)
+4 if SDCMT'=""
SET SDFDA(403.5,RECALLIEN_",",2.5)=$EXTRACT(SDCMT,1,80)
+5 SET SDFDA(403.5,RECALLIEN_",",2.6)=FASTING
+6 SET SDFDA(403.5,RECALLIEN_",",3)=APPTP
+7 SET SDFDA(403.5,RECALLIEN_",",4)=RRPROVIEN
+8 SET SDFDA(403.5,RECALLIEN_",",4.5)=CLINIEN
+9 if APPTLEN'=""
SET SDFDA(403.5,RECALLIEN_",",4.7)=APPTLEN
+10 SET SDFDA(403.5,RECALLIEN_",",5)=DATE
+11 if RECPPDT'=""
SET SDFDA(403.5,RECALLIEN_",",5.5)=RECPPDT
+12 if DAPTDT'=""
SET SDFDA(403.5,RECALLIEN_",",6)=DAPTDT
+13 SET SDFDA(403.5,RECALLIEN_",",7)=USERIEN
+14 ;only add if creating new record, cannot edit
if SDCREATE
SET SDFDA(403.5,RECALLIEN_",",7.5)=SDENTDT
+15 if SECPDT'=""
SET SDFDA(403.5,RECALLIEN_",",8)=SECPDT
+16 if EAS'=""
SET SDFDA(403.5,RECALLIEN_",",100)=EAS
+17 QUIT
+18 ;
BLDJSON ;Convert data to JSON
+1 NEW JSONERR
+2 SET JSONERR=""
+3 DO ENCODE^SDESJSON(.SDRECREQ,.RETN,.JSONERR)
+4 QUIT
+5 ;
KEY(RECALLIEN) ;check that user has the correct SECURITY KEY
+1 ;INPUT:
+2 ; RECALLIEN - Pointer to RECALL REMINDERS file 403.5
+3 ;RETURN
+4 ; 0=User has the correct SECURITY KEY
+5 ; 135=error number - user does not have correct security keys
+6 NEW KEY,KY,RET,SDPRV,SDFLAG
+7 SET RET=135
+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 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
+16 ;
