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

SDES2RECLLREQ.m

Go to the documentation of this file.
SDES2RECLLREQ ; ALB/TJB,TJB - VISTA SCHEDULING CREATE/UPDATE RECALL REQUESTS ; Jun 17, 2024
 ;;5.3;Scheduling;**866,881**;Aug 13, 1993;Build 10
 ;;Per VHA Directive 6402, this routine should not be modified
 ;
 Q  ;No Direct Call
 ;
 ; SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
 ; SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
 ; SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
 ; SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
 ; SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
 ;
 ; SDES2 CREATE RECALL REQUEST:
 ; SDINPUT("DFN") = POINTER TO PATIENT (#2) FILE (required)
 ; SDINPUT("ACCESSION NUMBER") = ACCESSION # (FREE TEXT)
 ; SDINPUT("COMMENT"") = COMMENT (FREE TEXT)
 ; SDINPUT("FASTING") = Labs: FASTING ; NON-FASTING ; @ - None (required)
 ; SDINPUT(APPOINTMENT TYPE") = (required)
 ;             Name of the RECALL REMINDERS APPT TYPE (#403.51) FILE
 ;              1    FOLLOW-UP          F
 ;              4    OTHER              O
 ;              3    SEMI-ANNUAL EXAM   SA
 ;              2    YEARLY EXAM        YEAR
 ; SDINPUT("RECALL PROVIDER IEN") = RECALL PROVIDER - POINTER TO RECALL REMINDERS PROVIDERS (#403.54) FILE (required)
 ; SDINPUT("CLINIC IEN") = CLINIC POINTER TO HOSPITAL LOCATION (#44) FILE (required)
 ; SDINPUT("APPOINTMENT LENGTH") = LENGTH OF APPOINTMENT NUMERIC BETWEEN 10 AND 240.
 ; SDINPUT("RECALL DATE") = Recall date in ISO8601 date format (no time). e.g., CCYY-MM-DD (required)
 ; SDINPUT(RECALL DATE PER PATIENT") = Recall date (per patient) in ISO8601 date format (no time). e.g., CCYY-MM-DD
 ; SDINPUT("DATE REMINDER SENT") = Date Reminder was sent in ISO8601 date format (no time). e.g., CCYY-MM-DD
 ; SDINPUT("SECOND PRINT DATE") = Second print date in ISO8601 date format (no time). e.g., CCYY-MM-DD
 ; SDINPUT("DATE ENTERED") = Date recall was added. Date is in ISO8601 format (e.g., CCYY-MM-DD)
 ;
CREATERECREQ(RETN,SDCONTEXT,SDINPUT) ;CREATE recall request
 N ERRORS,SDRECREQ,SDFDA,SDMSG,SDIEN
 D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
 I $D(ERRORS) S ERRORS("RecallReqCreate","IEN")="" D BUILDJSON^SDES2JSON(.RETN,.ERRORS) Q
 S SDINPUT("RECALL IEN")="+1"
 S SDINPUT("DATE ENTERED")=$$VALIDATERCDTNTRD(.ERRORS,$G(SDINPUT("DATE ENTERED")),SDINPUT("RECALL IEN"))
 D VALIDATE(.ERRORS,.SDINPUT)
 I $O(ERRORS("Error",""))'="" D RETURNERROR(.ERRORS,.SDRECREQ,.RETN,SDINPUT("RECALL IEN")) Q
 D BLDREC(.SDFDA,.SDINPUT,.SDCONTEXT)
 D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
 I $D(SDMSG) D ERRLOG^SDES2JSON(.ERRORS,134),RETURNERROR(.ERRORS,.SDRECREQ,.RETN,SDINPUT("RECALL IEN")) Q
 S SDRECREQ("RecallReqCreate","IEN")=SDIEN(1)
 D BUILDJSON^SDES2JSON(.RETN,.SDRECREQ)
 Q
 ;
 ; SDES2 EDIT RECALL REQUEST:
 ; SDINPUT("RECALL IEN") = IEN pointer to RECALL REMINDERS (#403.5) (required)
 ; SDINPUT("DFN") = POINTER TO PATIENT (#2) FILE (required)
 ; SDINPUT("ACCESSION NUMBER") = ACCESSION # (FREE TEXT)
 ; SDINPUT("COMMENT") = COMMENT (FREE TEXT)
 ; SDINPUT("FASTING") = Labs: FASTING ; NON-FASTING ; @ - None (required)
 ; SDINPUT("APPOINTMENT TYPE") = (required)
 ;             Name of the RECALL REMINDERS APPT TYPE (#403.51) FILE
 ;              1    FOLLOW-UP          F
 ;              4    OTHER              O
 ;              3    SEMI-ANNUAL EXAM   SA
 ;              2    YEARLY EXAM        YEAR
 ; SDINPUT("RECALL PROVIDER IEN") = RECALL PROVIDER - POINTER TO RECALL REMINDERS PROVIDERS (#403.54) FILE (required)
 ; SDINPUT("CLINIC IEN") = CLINIC POINTER TO HOSPITAL LOCATION (#44) FILE (required)
 ; SDINPUT("APPOINTMENT LENGTH") = LENGTH OF APPOINTMENT NUMERIC BETWEEN 10 AND 240.
 ; SDINPUT("RECALL DATE") = Recall date in ISO8601 date format (no time). e.g., CCYY-MM-DD (required)
 ; SDINPUT("RECALL DATE PER PATIENT") = Recall date (per patient) in ISO8601 date format (no time). e.g., CCYY-MM-DD
 ; SDINPUT("DATE REMINDER SENT") = Date Reminder was sent in ISO8601 date format (no time). e.g., CCYY-MM-DD
 ; SDINPUT("SECOND PRINT DATE") = Second print date in ISO8601 date format (no time). e.g., CCYY-MM-DD
 ;
UPDRECALLREQ(RETN,SDCONTEXT,SDINPUT) ;RECALLIEN,DFN,ACCNO,SDCMT,FASTING,APPTP,RRPROVIEN,CLINIEN,APPTLEN,DATE,RECPPDT,DAPTDT,USERIEN,SECPDT,EAS) ;update recall request
 N ERRORS,SDRECREQ,SDFDA,SDMSG,SDIEN
 D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
 I $D(ERRORS) S ERRORS("RecallReqEdit","IEN")="" D BUILDJSON^SDES2JSON(.RETN,.ERRORS) Q
 D VALIDATE(.ERRORS,.SDINPUT,.SDCONTEXT)
 I $O(ERRORS("Error",""))'="" D RETURNERROR(.ERRORS,.SDRECREQ,.RETN,SDINPUT("RECALL IEN")) Q
 D BLDREC(.SDFDA,.SDINPUT,.SDCONTEXT)
 D FILE^DIE(,"SDFDA","SDMSG")
 I $D(SDMSG) D ERRLOG^SDES2JSON(.ERRORS,134),RETURNERROR(.ERRORS,.SDRECREQ,.RETN,SDINPUT("RECALL IEN")) Q
 S SDRECREQ("RecallReqEdit","IEN")=SDINPUT("RECALL IEN")
 D BUILDJSON^SDES2JSON(.RETN,.SDRECREQ)
 Q
 ;
BLDREC(SDFDA,SDINPUT,SDCONTEXT) ;build and file record
 N RECALLIEN
 S RECALLIEN=SDINPUT("RECALL IEN")
 S SDFDA=$NA(SDFDA(403.5,RECALLIEN_",")) ;recall
 S SDFDA(403.5,RECALLIEN_",",.01)=SDINPUT("DFN")
 S:$G(SDINPUT("ACCESSION NUMBER"))'="" SDFDA(403.5,RECALLIEN_",",2)=$E(SDINPUT("ACCESSION NUMBER"),1,25)
 S:$G(SDINPUT("COMMENT"))'="" SDFDA(403.5,RECALLIEN_",",2.5)=$E(SDINPUT("COMMENT"),1,80)
 S SDFDA(403.5,RECALLIEN_",",2.6)=SDINPUT("FASTING")
 S SDFDA(403.5,RECALLIEN_",",3)=SDINPUT("APPOINTMENT TYPE")
 S SDFDA(403.5,RECALLIEN_",",4)=SDINPUT("RECALL PROVIDER IEN")
 S SDFDA(403.5,RECALLIEN_",",4.5)=SDINPUT("CLINIC IEN")
 S:SDINPUT("APPOINTMENT LENGTH")'="" SDFDA(403.5,RECALLIEN_",",4.7)=SDINPUT("APPOINTMENT LENGTH")
 S SDFDA(403.5,RECALLIEN_",",5)=SDINPUT("RECALL DATE")
 S:$G(SDINPUT("RECALL DATE PER PATIENT"))'="" SDFDA(403.5,RECALLIEN_",",5.5)=SDINPUT("RECALL DATE PER PATIENT")
 S:$G(SDINPUT("DATE REMINDER SENT"))'="" SDFDA(403.5,RECALLIEN_",",6)=SDINPUT("DATE REMINDER SENT")
 S SDFDA(403.5,RECALLIEN_",",7)=$S($G(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
 S:RECALLIEN="+1" SDFDA(403.5,RECALLIEN_",",7.5)=SDINPUT("DATE ENTERED") ;only add if creating new record, cannot edit
 S:$G(SDINPUT("SECOND PRINT DATE"))'="" SDFDA(403.5,RECALLIEN_",",8)=SDINPUT("SECOND PRINT DATE")
 S SDFDA(403.5,RECALLIEN_",",100)=$G(SDCONTEXT("ACHERON AUDIT ID"))
 Q
 ;
 ; SDINPUT("RECALL IEN")
 ; SDINPUT("DFN")
 ; SDINPUT("ACCESSION NUMBER")
 ; SDINPUT("COMMENT")
 ; SDINPUT("FASTING")
 ; SDINPUT("APPOINTMENT TYPE")
 ; SDINPUT("RECALL PROVIDER IEN")
 ; SDINPUT("CLINIC IEN")
 ; SDINPUT("APPOINTMENT LENGTH")
 ; SDINPUT("RECALL DATE")
 ; SDINPUT("RECALL DATE PER PATIENT")
 ; SDINPUT("DATE REMINDER SENT")
 ; SDINPUT("SECOND PRINT DATE")
VALIDATE(ERRORS,SDINPUT,SDCONTEXT) ;
 N OLDDFN
 S OLDDFN=""
 S SDINPUT("RECALL IEN")=$$VALIDATERECALIEN(.ERRORS,$G(SDINPUT("RECALL IEN")),$G(SDCONTEXT("USER DUZ")))
 I '$D(ERRORS),SDINPUT("RECALL IEN")'="+1" S OLDDFN=$$GET1^DIQ(403.5,SDINPUT("RECALL IEN"),.01,"I")
 S SDINPUT("DFN")=$$VALIDATEDFN(.ERRORS,$G(SDINPUT("DFN")),OLDDFN)
 S SDINPUT("FASTING")=$$VALIDATEFASTING(.ERRORS,$G(SDINPUT("FASTING")))
 S SDINPUT("APPOINTMENT TYPE")=$$VALIDATEAPPTP(.ERRORS,$G(SDINPUT("APPOINTMENT TYPE")))
 S SDINPUT("RECALL PROVIDER IEN")=$$VALIDATERRPRVIEN(.ERRORS,$G(SDINPUT("RECALL PROVIDER IEN")))
 S SDINPUT("CLINIC IEN")=$$VALIDATECLINIEN(.ERRORS,$G(SDINPUT("CLINIC IEN")))
 S SDINPUT("RECALL DATE")=$$VALIDATERECALLDT(.ERRORS,$G(SDINPUT("RECALL DATE")))
 S SDINPUT("APPOINTMENT LENGTH")=$$VALIDATEAPPTLEN(.ERRORS,$G(SDINPUT("APPOINTMENT LENGTH")))
 S SDINPUT("RECALL DATE PER PATIENT")=$$VALIDATERECPPDT(.ERRORS,$G(SDINPUT("RECALL DATE PER PATIENT")))
 S SDINPUT("DATE REMINDER SENT")=$$VALIDATEDAPTDT(.ERRORS,$G(SDINPUT("DATE REMINDER SENT")))
 S SDINPUT("SECOND PRINT DATE")=$$VALIDATESECPDT(.ERRORS,$G(SDINPUT("SECOND PRINT DATE")))
 S SDINPUT("COMMENT")=$$VALIDATESDCMT(.ERRORS,$G(SDINPUT("COMMENT")))
 S SDINPUT("ACCESSION NUMBER")=$$VALIDATEACCNUM(.ERRORS,$G(SDINPUT("ACCESSION NUMBER")))
 Q
 ;
VALIDATERECALIEN(ERRORS,RECALLIEN,USERDUZ) ;Validate Recall IEN
 I $G(RECALLIEN)="" D ERRLOG^SDES2JSON(.ERRORS,16) Q RECALLIEN
 I (RECALLIEN'="+1")&('$D(^SD(403.5,$G(RECALLIEN)))) D ERRLOG^SDES2JSON(.ERRORS,17) Q RECALLIEN
 ;check that user has the correct security key
 I $$KEY(RECALLIEN,$G(USERDUZ))>0 D ERRLOG^SDES2JSON(.ERRORS,135)
 Q RECALLIEN
 ;
VALIDATEDFN(ERRORS,DFN,OLDDFN) ;Validate Patient DFN
 D VALPATDFN^SDES2VAL2(.ERRORS,$G(DFN),1)
 I DFN'="",OLDDFN'="",DFN'=OLDDFN D ERRLOG^SDES2JSON(.ERRORS,2,"Patient ID on Recall doesn't match passed in Patient ID")
 Q DFN
 ;
VALIDATEFASTING(ERRORS,FASTING) ;Validate Fasting
 I FASTING="" D ERRLOG^SDES2JSON(.ERRORS,141) Q 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:138)
 I FASTING=138 D ERRLOG^SDES2JSON(.ERRORS,138)
 Q FASTING
 ;
VALIDATEAPPTP(ERRORS,APPTP) ;Validate Appointment Type
 I APPTP="" D ERRLOG^SDES2JSON(.ERRORS,139) Q APPTP
 I +APPTP,$D(^SD(403.51,APPTP,0)) Q APPTP
 I +APPTP,'$D(^SD(403.51,APPTP,0)) D ERRLOG^SDES2JSON(.ERRORS,132) Q APPTP
 S APPTP=$O(^SD(403.51,"B",APPTP,""))
 I APPTP="" D ERRLOG^SDES2JSON(.ERRORS,139) Q APPTP
 Q APPTP
 ;
VALIDATERRPRVIEN(ERRORS,RRPROVIEN) ;Validate Recall Provider IEN
 I RRPROVIEN="" D ERRLOG^SDES2JSON(.ERRORS,137) Q RRPROVIEN
 I $G(RRPROVIEN)'="",'$D(^SD(403.54,RRPROVIEN)) D ERRLOG^SDES2JSON(.ERRORS,131)
 Q RRPROVIEN
 ;
VALIDATECLINIEN(ERRORS,CLINIEN) ;Validate Clinic IEN
 I CLINIEN="" D ERRLOG^SDES2JSON(.ERRORS,18) Q CLINIEN
 I CLINIEN'="",'$D(^SC(CLINIEN)) D ERRLOG^SDES2JSON(.ERRORS,19)
 Q CLINIEN
 ;
VALIDATERECALLDT(ERRORS,RECALLDATE) ;Validate Recall Date
 I RECALLDATE="" D ERRLOG^SDES2JSON(.ERRORS,140) Q RECALLDATE
 I RECALLDATE'="" S RECALLDATE=$$ISOTFM^SDAMUTDT(RECALLDATE)
 I RECALLDATE=-1 D ERRLOG^SDES2JSON(.ERRORS,133)
 Q RECALLDATE
 ;
VALIDATERCDTNTRD(ERRORS,RECDTENTRD,RECALLIEN) ;Validate Recall Date Entered
 I RECALLIEN'="+1" Q ""  ; This is an IEN, so can't edit Recall Date Entered
 I ($G(RECDTENTRD)'="") S RECDTENTRD=$$ISOTFM^SDAMUTDT(RECDTENTRD)
 I (RECDTENTRD=-1)!(RECDTENTRD="") S RECDTENTRD=DT ;
 Q RECDTENTRD
 ;
VALIDATEAPPTLEN(ERRORS,LENGTHOFAPPT) ;Validate Length of Appointment
 S LENGTHOFAPPT=$G(LENGTHOFAPPT,"") I LENGTHOFAPPT="" Q LENGTHOFAPPT
 I '+LENGTHOFAPPT D ERRLOG^SDES2JSON(.ERRORS,116) Q LENGTHOFAPPT
 I LENGTHOFAPPT'="" S:((+LENGTHOFAPPT<10)!(+LENGTHOFAPPT>240)) LENGTHOFAPPT=""
 Q LENGTHOFAPPT
 ;
VALIDATERECPPDT(ERRORS,RECPPTDT) ;Validate Recall Date Per Patient
 S RECPPTDT=$G(RECPPTDT,"") S RECPPTDT=$$ISOTFM^SDAMUTDT(RECPPTDT)
 I RECPPTDT=-1 S RECPPTDT=""  ;VSE-2396
 Q RECPPTDT
 ;
VALIDATEDAPTDT(ERRORS,DTRMSENT) ;Validate Date Reminder Sent
 S DTRMSENT=$G(DTRMSENT,"")
 S DTRMSENT=$$ISOTFM^SDAMUTDT(DTRMSENT)
 I DTRMSENT=-1 S DTRMSENT=""  ;VSE-2396
 Q DTRMSENT
 ;
VALIDATESECPDT(ERRORS,SECPRNTDT) ;Validate Second Print Date
 S SECPRNTDT=$G(SECPRNTDT,"")
 I SECPRNTDT'="" S SECPRNTDT=$$ISOTFM^SDAMUTDT(SECPRNTDT)
 I SECPRNTDT=-1 S SECPRNTDT=""  ;VSE-2396
 Q SECPRNTDT
 ;
VALIDATESDCMT(ERRORS,SDCMT) ;Validate Comment
 S SDCMT=$G(SDCMT,"")
 S SDCMT=$TR($G(SDCMT),"^"," ")
 Q SDCMT
 ;
VALIDATEACCNUM(ERRORS,SDACC) ;Validate ACCESSION NUMBER
 S SDACC=$G(SDACC,"")
 S SDACC=$TR($G(SDACC),"^"," ")
 Q SDACC
 ;
RETURNERROR(ERRORS,SDRECREQ,RETN,REQIEN) ;
 M SDRECREQ=ERRORS
 D SETEMPTYOBJ(.SDRECREQ,REQIEN)
 D BUILDJSON^SDES2JSON(.RETN,.SDRECREQ)
 Q
 ;
SETEMPTYOBJ(SDRECREQ,SDCREATE) ;Set the object to NULL
 I SDCREATE="+1" S SDRECREQ("RecallReqCreate","IEN")="" Q
 S SDRECREQ("RecallReqEdit","IEN")=""
 Q
 ;
KEY(RECALLIEN,USERDUZ) ;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,$S(USERDUZ'="":USERDUZ,1:DUZ))
 ..I $G(KY(0))'=0 S RET=0
 Q RET
 ;