Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDESUPDRECREQ2

SDESUPDRECREQ2.m

Go to the documentation of this file.
  1. SDESUPDRECREQ2 ;ALB/LAB,KML,MGD,RRM,ANU,BWF - VISTA SCHEDULING CREATE EDIT RECALL REQ RPC ;March 06, 2023
  1. ;;5.3;Scheduling;**823,842,861,864**;Aug 13, 1993;Build 15
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. ; Documented API's and Integration Agreements
  1. ; --------------------------------------------
  1. ; Reference to $$LKUP^XPDKEY is supported by IA #1367
  1. ; Reference to OWNSKEY^XUSRB is supported by IA #3277
  1. ;
  1. ;INPUT:
  1. ; RECALLIEN - sent for UPDATE of RECALL REQUEST only(Required for Update) IEN pointer to RECALL REMINDERS
  1. ; DFN - (required) DFN Pointer to PATIENT file
  1. ; ACCNO - (optional) Accession # (free-text 1-25 characters)
  1. ; SDCMT - (optional) COMMENT (free-text 1-80 characters)
  1. ; FASTING - (required) FAST/NON-FASTING valid values: FASTING,NON-FASTING,NONE
  1. ; APPTP - (required) Test/App pointer or name (.01) to RECALL REMINDERS APPT TYPE file 403.51
  1. ; RRPROVIEN - (required) Provider - Pointer to RECALL REMINDERS PROVIDERS file 403.54
  1. ; CLINIEN - (required) Clinic pointer to HOSPITAL LOCATION file
  1. ; APPTLEN - (optional) Length of Appointment numeric between 10 and 120
  1. ; DATE - (required) Recall Date in ISO8601 format (no time). e.g., CCYY-MM-DD
  1. ; RECPPDT - (optional) Recall Date (Per patient) in ISO8601 format (no time) e.g., CCYY-MM-DD
  1. ; DAPTDT - (optional) Date Reminder Sent in ISO8601 format (no time) e.g., CCYY-MM-DD
  1. ; USERIEN - (optional) User Who Entered Recall pointer to NEW PERSON file; default to current user
  1. ; SECPDT - (optional) Second Print Date in ISO8601 format (no time) e.g., CCYY-MM-DD
  1. ; SDENTDT - (optional) Date recall entered in ISO8601 format e.g., CCYY-MM-DD)
  1. ; EAS - (optional) EAS Tracking Number
  1. ;
  1. ;RETURN:
  1. ; Successful Return:
  1. ; RETURNJSON = Returns the REQUEST RECALL IEN in JSON formatted string.
  1. ; Otherwise, JSON Errors will be returned for any invalid/missing parameters.
  1. ;
  1. ; The parameter list for this RPC must be kept in sync.
  1. ; If you need to add or remove a parameter, ensure that the Remote Procedure File #8994 definition is also updated.
  1. ;
  1. ; copy of SDESUPDRECREQ
  1. Q
  1. ;
  1. CREATERECREQ(RETN,DFN,ACCNO,SDCMT,FASTING,APPTP,RRPROVIEN,CLINIEN,APPTLEN,DATE,RECPPDT,DAPTDT,USERIEN,SECPDT,SDENTDT,EAS) ;CREATE recall request
  1. N ERRORS,SDRECREQ,RECALLIEN,SDCREATE,SDFDA,SDMSG,SDIEN
  1. S RECALLIEN="+1",SDCREATE=1
  1. D VALIDATE(.ERRORS,SDCREATE)
  1. I $O(ERRORS("Error",""))'="" D RETURNERROR(.ERRORS,.SDRECREQ,.RETN,SDCREATE) Q
  1. D BLDREC
  1. D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
  1. I $D(SDMSG) D ERRLOG^SDESJSON(.ERRORS,134),RETURNERROR(.ERRORS,.SDRECREQ,.RETN,SDCREATE) Q
  1. S SDRECREQ("RecallReqCreate","IEN")=SDIEN(1)
  1. D BUILDJSON^SDESBUILDJSON(.RETN,.SDRECREQ)
  1. Q
  1. ;
  1. UPDRECALLREQ(RETN,RECALLIEN,DFN,ACCNO,SDCMT,FASTING,APPTP,RRPROVIEN,CLINIEN,APPTLEN,DATE,RECPPDT,DAPTDT,USERIEN,SECPDT,EAS) ;update recall request
  1. N ERRORS,SDRECREQ,SDFDA,SDMSG,SDIEN
  1. S SDCREATE=0
  1. D VALIDATE(.ERRORS,SDCREATE)
  1. I $O(ERRORS("Error",""))'="" D RETURNERROR(.ERRORS,.SDRECREQ,.RETN,SDCREATE) Q
  1. D BLDREC
  1. D FILE^DIE(,"SDFDA","SDMSG")
  1. I $D(SDMSG) D ERRLOG^SDESJSON(.ERRORS,134),RETURNERROR(.ERRORS,.SDRECREQ,.RETN,SDCREATE) Q
  1. S SDRECREQ("RecallReqEdit","IEN")=RECALLIEN
  1. D BUILDJSON^SDESBUILDJSON(.RETN,.SDRECREQ)
  1. Q
  1. ;
  1. BLDREC ;build and file record
  1. S SDFDA=$NA(SDFDA(403.5,RECALLIEN_",")) ;recall
  1. S SDFDA(403.5,RECALLIEN_",",.01)=DFN
  1. S:$G(ACCNO)'="" SDFDA(403.5,RECALLIEN_",",2)=$E(ACCNO,1,25)
  1. S:SDCMT'="" SDFDA(403.5,RECALLIEN_",",2.5)=$E(SDCMT,1,80)
  1. S SDFDA(403.5,RECALLIEN_",",2.6)=FASTING
  1. S SDFDA(403.5,RECALLIEN_",",3)=APPTP
  1. S SDFDA(403.5,RECALLIEN_",",4)=RRPROVIEN
  1. S SDFDA(403.5,RECALLIEN_",",4.5)=CLINIEN
  1. S:APPTLEN'="" SDFDA(403.5,RECALLIEN_",",4.7)=APPTLEN
  1. S SDFDA(403.5,RECALLIEN_",",5)=DATE
  1. S:RECPPDT'="" SDFDA(403.5,RECALLIEN_",",5.5)=RECPPDT
  1. S:DAPTDT'="" SDFDA(403.5,RECALLIEN_",",6)=DAPTDT
  1. S SDFDA(403.5,RECALLIEN_",",7)=USERIEN
  1. S:SDCREATE SDFDA(403.5,RECALLIEN_",",7.5)=SDENTDT ;only add if creating new record, cannot edit
  1. S:SECPDT'="" SDFDA(403.5,RECALLIEN_",",8)=SECPDT
  1. S:EAS'="" SDFDA(403.5,RECALLIEN_",",100)=EAS
  1. Q
  1. ;
  1. VALIDATE(ERRORS,SDCREATE) ;
  1. D INITINPUTPAR(SDCREATE) ;initialize input parameter
  1. S RECALLIEN=$$VALIDATERECALIEN(.ERRORS,RECALLIEN)
  1. S DFN=$$VALIDATEDFN(.ERRORS,DFN)
  1. S FASTING=$$VALIDATEFASTING(.ERRORS,FASTING)
  1. S APPTP=$$VALIDATEAPPTP(.ERRORS,APPTP)
  1. S RRPROVIEN=$$VALIDATERRPRVIEN(.ERRORS,RRPROVIEN)
  1. S CLINIEN=$$VALIDATECLINIEN(.ERRORS,CLINIEN)
  1. S DATE=$$VALIDATERECALLDT(.ERRORS,DATE)
  1. I $G(SDCREATE) S SDENTDT=$$VALIDATERCDTNTRD(.ERRORS,SDCREATE,SDENTDT)
  1. S APPTLEN=$$VALIDATEAPPTLEN(.ERRORS,APPTLEN)
  1. S RECPPDT=$$VALIDATERECPPDT(.ERRORS,RECPPDT)
  1. S DAPTDT=$$VALIDATEDAPTDT(.ERRORS,DAPTDT)
  1. S USERIEN=$$VALIDATEUSERIEN(.ERRORS,USERIEN)
  1. S SECPDT=$$VALIDATESECPDT(.ERRORS,SECPDT)
  1. S SDCMT=$$VALIDATESDCMT(.ERRORS,SDCMT)
  1. S EAS=$$VALIDATEEAS(.ERRORS,EAS)
  1. Q
  1. ;
  1. INITINPUTPAR(SDCREATE) ;Initialized Input Paramaters
  1. S:SDCREATE<1 RECALLIEN=$G(RECALLIEN)
  1. S DFN=$G(DFN)
  1. S ACCNO=$G(ACCNO)
  1. S SDCMT=$G(SDCMT)
  1. S FASTING=$G(FASTING)
  1. S APPTP=$G(APPTP)
  1. S RRPROVIEN=$G(RRPROVIEN)
  1. S CLINIEN=$G(CLINIEN)
  1. S APPTLEN=$G(APPTLEN)
  1. S DATE=$G(DATE)
  1. S RECPPDT=$G(RECPPDT)
  1. S DAPTDT=$G(DAPTDT)
  1. S USERIEN=$G(USERIEN)
  1. S SECPDT=$G(SECPDT)
  1. S SDENTDT=$G(SDENTDT)
  1. S EAS=$G(EAS)
  1. Q
  1. ;
  1. VALIDATERECALIEN(ERRORS,RECALLIEN) ;Validate Recall IEN
  1. I $G(RECALLIEN)="" D ERRLOG^SDESJSON(.ERRORS,16) Q RECALLIEN
  1. I (RECALLIEN'="+1")&('$D(^SD(403.5,$G(RECALLIEN)))) D ERRLOG^SDESJSON(.ERRORS,17) Q RECALLIEN
  1. ;check that user has the correct security key
  1. I $$KEY(RECALLIEN)>0 D ERRLOG^SDESJSON(.ERRORS,135)
  1. Q RECALLIEN
  1. ;
  1. VALIDATEDFN(ERRORS,DFN) ;Validate Patient DFN
  1. I DFN="" D ERRLOG^SDESJSON(.ERRORS,1)
  1. I DFN'="",'$D(^DPT(DFN,0)) D ERRLOG^SDESJSON(.ERRORS,2)
  1. Q DFN
  1. ;
  1. VALIDATEFASTING(ERRORS,FASTING) ;Validate Fasting
  1. I FASTING="" D ERRLOG^SDESJSON(.ERRORS,141) Q FASTING
  1. 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)
  1. I FASTING=138 D ERRLOG^SDESJSON(.ERRORS,138)
  1. Q FASTING
  1. ;
  1. VALIDATEAPPTP(ERRORS,APPTP) ;Validate Appointment Type
  1. I APPTP="" D ERRLOG^SDESJSON(.ERRORS,139) Q APPTP
  1. I +APPTP,$D(^SD(403.51,APPTP,0)) Q APPTP
  1. I +APPTP,'$D(^SD(403.51,APPTP,0)) D ERRLOG^SDESJSON(.ERRORS,132) Q APPTP
  1. S APPTP=$O(^SD(403.51,"B",APPTP,""))
  1. I APPTP="" D ERRLOG^SDESJSON(.ERRORS,132) Q APPTP
  1. Q APPTP
  1. ;
  1. VALIDATERRPRVIEN(ERRORS,RRPROVIEN) ;Validate Recall Provider IEN
  1. I RRPROVIEN="" D ERRLOG^SDESJSON(.ERRORS,137) Q RRPROVIEN
  1. I $G(RRPROVIEN)'="",'$D(^SD(403.54,RRPROVIEN)) D ERRLOG^SDESJSON(.ERRORS,131)
  1. Q RRPROVIEN
  1. ;
  1. VALIDATECLINIEN(ERRORS,CLINIEN) ;Validate Clinic IEN
  1. I CLINIEN="" D ERRLOG^SDESJSON(.ERRORS,18) Q CLINIEN
  1. I CLINIEN'="",'$D(^SC(CLINIEN)) D ERRLOG^SDESJSON(.ERRORS,19)
  1. Q CLINIEN
  1. ;
  1. VALIDATERECALLDT(ERRORS,RECALLDATE) ;Validate Recall Date
  1. I RECALLDATE="" D ERRLOG^SDESJSON(.ERRORS,140) Q RECALLDATE
  1. I RECALLDATE'="" S RECALLDATE=$$ISOTFM^SDAMUTDT(RECALLDATE)
  1. I RECALLDATE=-1 D ERRLOG^SDESJSON(.ERRORS,133)
  1. Q RECALLDATE
  1. ;
  1. VALIDATERCDTNTRD(ERRORS,SDRCREATE,RECDTENTRD) ;Validate Recall Date Entered
  1. I (SDRCREATE)&($G(RECDTENTRD)'="") S RECDTENTRD=$$ISOTFM^SDAMUTDT(RECDTENTRD)
  1. I (RECDTENTRD=-1)!(RECDTENTRD="") S RECDTENTRD=DT ;
  1. Q RECDTENTRD
  1. ;
  1. VALIDATEAPPTLEN(ERRORS,LENGTHOFAPPT) ;Validate Length of Appointment
  1. S LENGTHOFAPPT=$G(LENGTHOFAPPT,"") I LENGTHOFAPPT="" Q LENGTHOFAPPT
  1. I '+LENGTHOFAPPT D ERRLOG^SDESJSON(.ERRORS,116) Q LENGTHOFAPPT
  1. I LENGTHOFAPPT'="" S:((+LENGTHOFAPPT<10)!(+LENGTHOFAPPT>120)) LENGTHOFAPPT=""
  1. Q LENGTHOFAPPT
  1. ;
  1. VALIDATERECPPDT(ERRORS,RECPPTDT) ;Validate Recall Date Per Patient
  1. S RECPPTDT=$G(RECPPTDT,"") S RECPPTDT=$$ISOTFM^SDAMUTDT(RECPPTDT)
  1. I RECPPTDT=-1 S RECPPTDT="" ;VSE-2396
  1. Q RECPPTDT
  1. ;
  1. VALIDATEDAPTDT(ERRORS,DTRMSENT) ;Validate Date Reminder Sent
  1. S DTRMSENT=$G(DTRMSENT,"")
  1. S DTRMSENT=$$ISOTFM^SDAMUTDT(DTRMSENT)
  1. I DTRMSENT=-1 S DTRMSENT="" ;VSE-2396
  1. Q DTRMSENT
  1. ;
  1. VALIDATEUSERIEN(ERRORS,USERIEN) ;Validate User IEN
  1. S USERIEN=$G(USERIEN,"")
  1. I USERIEN'?.N S USERIEN=DUZ Q USERIEN
  1. I (USERIEN="")!('$D(^VA(200,+USERIEN))) S USERIEN=DUZ
  1. Q USERIEN
  1. ;
  1. VALIDATESECPDT(ERRORS,SECPRNTDT) ;Validate Second Print Date
  1. S SECPRNTDT=$G(SECPRNTDT,"")
  1. I SECPRNTDT'="" S SECPRNTDT=$$ISOTFM^SDAMUTDT(SECPDT)
  1. I SECPRNTDT=-1 S SECPRNTDT="" ;VSE-2396
  1. Q SECPRNTDT
  1. ;
  1. VALIDATESDCMT(ERRORS,SDCMT) ;Validate Length of Appointment
  1. S SDCMT=$G(SDCMT,"")
  1. S SDCMT=$TR($G(SDCMT),"^"," ")
  1. Q SDCMT
  1. ;
  1. VALIDATEEAS(ERRORS,SDEAS) ;Validate SDEAS
  1. S SDEAS=$G(SDEAS,"")
  1. I $L(SDEAS) S SDEAS=$$EASVALIDATE^SDESUTIL(SDEAS)
  1. I SDEAS=-1 D ERRLOG^SDESJSON(.ERRORS,142)
  1. Q SDEAS
  1. ;
  1. RETURNERROR(ERRORS,SDRECREQ,RETN,SDCREATE) ;
  1. M SDRECREQ=ERRORS
  1. D SETEMPTYOBJ(.SDRECREQ,SDCREATE)
  1. D BUILDJSON^SDESBUILDJSON(.RETN,.SDRECREQ)
  1. Q
  1. ;
  1. SETEMPTYOBJ(SDRECREQ,SDCREATE) ;Set the object to NULL
  1. I SDCREATE S SDRECREQ("RecallReqCreate","IEN")="" Q
  1. S SDRECREQ("RecallReqEdit","IEN")=""
  1. Q
  1. ;
  1. KEY(RECALLIEN) ;check that user has the correct SECURITY KEY
  1. ;INPUT:
  1. ; RECALLIEN - Pointer to RECALL REMINDERS file 403.5
  1. ;RETURN
  1. ; 0=User has the correct SECURITY KEY
  1. ; 135=error number - user does not have correct security keys
  1. N KEY,KY,RET,SDPRV,SDFLAG
  1. S RET=135
  1. S (SDPRV,KEY,SDFLAG)="" S SDPRV=$P($G(^SD(403.5,+RECALLIEN,0)),U,5) D
  1. .I SDPRV="" S RET=0
  1. .I SDPRV'="" S KEY=$P($G(^SD(403.54,SDPRV,0)),U,7) D
  1. ..I KEY="" S RET=0 Q
  1. ..N VALUE
  1. ..S VALUE=$$LKUP^XPDKEY(KEY) K KY D OWNSKEY^XUSRB(.KY,VALUE,DUZ)
  1. ..I $G(KY(0))'=0 S RET=0
  1. Q RET
  1. ;