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  Sep 23, 2025@20:34:39                                                                                                                                                                                               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      ;