SDESCONTACTS ;ALB/BWF - VISTA SCHEDULING CONTACT RPCS ;JUL 18, 2023
;;5.3;Scheduling;**835,837,845,851**;Aug 13, 1993;Build 10
;;Per VHA Directive 6402, this routine should not be modified
Q
; RPC: SDES CONTACT NEW
; INPUT:
;CONTACT("CLINIC")=CLINIC IEN
;- Clinic IEN from the HOSPITAL LOCATION FILE (#44
;CONTACT("COMMENTS")=COMMENTS
;- Free text comments (1-80 characters)
;CONTACT("CONTACTIEN")=CONTACT IEN
;- IEN of the main contact entry in the SDEC CONTACT file (#409.86)
;CONTACT("CONTACTTYPE")=CONTACT TYPE
;- Contact Type (C - Call, L - Letter, E - Email, T - Text, S - Secure messaging)
;CONTACT("DFN")=PATIENT DFN
;- Pointer to the PATIENT file (#2)
;CONTACT("DTTMENTERED")=DATE/TIME ENTERED (ISO FORMAT)
;- ISO Date/Time
;CONTACT("DTTMOFCONTACT")=DATE/TIME OF CONTACT (ISO FORMAT)
;- ISO Date/Time
;CONTACT("LEFTMESSAGE")=0 for no, 1 for yes
;CONTACT("PREFDATE")=PREFERRED DATE (ISO FORMAT)
;- ISO Date
;CONTACT("REQTYPE")=REQUEST TYPE
;- Request Type (A - APPT, R - RECALL, C - CONSULT)
;CONTACT("REQUESTIEN")=REQUEST IEN
;- Request IEN (Variable pointer) based on the request type
; A - SDEC APPT REQUEST (#409.85)
; C - REQUEST/CONSULTATION file (#123)
; R - RECALL REQUEST file (#403.5)
;CONTACT("SERVICE")=SERVICE
;- Pointer to the CLINIC STOP file (#40.7)
;
ADDUPD(RESULT,CONTACT) ;
N ERRORS,DFN,CLINIC,PREFDATE,REQTYPE,SERVICE,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DTTMENTERED,REQUESTIEN,NEWCONTACT
N NEWIEN,SDREQPTR40986,REQTYPE40985,FILERR,FDA,NEWCONTIEN,SUBIENS,CONTACTIEN,SEQUENCE,LEFTMSG,NEWCONTATTMTIEN
S DFN=$G(CONTACT("DFN"))
S CLINIC=$G(CONTACT("CLINIC"))
S PREFDATE=""
S REQTYPE=$G(CONTACT("REQTYPE"))
S SERVICE=$G(CONTACT("SERVICE"))
S DTTMOFCONTACT=$G(CONTACT("DTTMOFCONTACT"))
S CONTACTTYPE=$G(CONTACT("CONTACTTYPE"))
S COMMENTS=$G(CONTACT("COMMENTS"))
S DTTMENTERED=$G(CONTACT("DTTMENTERED"))
S REQUESTIEN=$G(CONTACT("REQUESTIEN"))
S LEFTMSG=$G(CONTACT("LEFTMESSAGE"))
I LEFTMSG="" S LEFTMSG=0
D VALIDATEDFN^SDESINPUTVALUTL(.ERRORS,DFN)
I CLINIC'="" D VALIDATECLINIC(.ERRORS,CLINIC)
I $D(ERRORS) S ERRORS("Contact",1)="" D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS) Q
D VALREQTYPE(.ERRORS,REQTYPE,"^R^A^RTC^C^P^V^")
I $G(SERVICE)]"" D VALSERVICE(.ERRORS,SERVICE)
I $G(LEFTMSG)'="" D VALLEFTMSG(.ERRORS,LEFTMSG)
S DTTMOFCONTACT=$$VALDATE2^SDESVALUTIL(.ERRORS,DTTMOFCONTACT,CLINIC,389,390)
; validate text input based on field definition
D VALTEXTINPUT(.ERRORS,COMMENTS,409.863,2,1)
S DTTMENTERED=$$VALDATE2^SDESVALUTIL(.ERRORS,DTTMENTERED,CLINIC,387,388)
I $D(ERRORS) S ERRORS("Contact",1)="" D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS) Q
D VALREQIEN(.ERRORS,REQUESTIEN,REQTYPE)
D VALSETOFCODES(.ERRORS,CONTACTTYPE,409.863,1,"Contact Type")
S CONTACTIEN=$$GETCONTIEN(.ERRORS,REQUESTIEN,REQTYPE)
I $D(ERRORS) S ERRORS("Contact",1)="" D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS) Q
I REQUESTIEN D
.S SDREQPTR40986=""
.I (REQTYPE="A")!(REQTYPE="RTC")!(REQTYPE="V") D
..Q:$$GET1^DIQ(409.85,REQUESTIEN,.01,"I")'=DFN
..S REQTYPE40985=$$GET1^DIQ(409.85,REQUESTIEN,4,"I")
..I REQTYPE40985'="APPT",REQTYPE40985'="RTC",REQTYPE40985'="VETERAN" Q
..S SDREQPTR40986=REQUESTIEN_";"_"SDEC(409.85,"
..S PREFDATE=$$GET1^DIQ(409.85,REQUESTIEN,22,"I")
.Q:SDREQPTR40986'=""
.I REQTYPE="C"!(REQTYPE="P") D
..Q:$$GET1^DIQ(123,REQUESTIEN,.02,"I")'=DFN
..Q:$$GET1^DIQ(123,REQUESTIEN,13,"I")'=REQTYPE
..Q:CLINIC'=""&(CLINIC'=$$GET1^DIQ(123,REQUESTIEN,.04,"I"))
..S SDREQPTR40986=REQUESTIEN_";"_"GMR(123,"
..I $D(^SDEC(409.87,"B",REQUESTIEN)) S PREFDATE=$$GETPID^SDECCONSJSON(REQUESTIEN)
..I '$D(^SDEC(409.87,"B",REQUESTIEN))!(PREFDATE="") S PREFDATE=$$GET1^DIQ(123,REQUESTIEN,17,"I")
.Q:SDREQPTR40986'=""
.I REQTYPE="R" D
..Q:$$GET1^DIQ(403.5,REQUESTIEN,.01,"I")'=DFN
..I CLINIC'="",$$GET1^DIQ(403.5,REQUESTIEN,4.5,"I")'=CLINIC Q
..S SDREQPTR40986=REQUESTIEN_";"_"SD(403.5,"
..S PREFDATE=$$GET1^DIQ(403.5,REQUESTIEN,5,"I")
I $G(SDREQPTR40986)="" D Q
.D ERRLOG^SDESJSON(.ERRORS,394)
.S ERRORS("Contact",1)=""
.D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
I $G(PREFDATE)="" D
.D ERRLOG^SDESJSON(.ERRORS,408)
I $D(ERRORS) D Q
.S ERRORS("Contact",1)=""
.D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
I 'CONTACTIEN D
.D BLDNEWCONT(.FDA,"+1,",DFN,CLINIC,PREFDATE,REQTYPE,SERVICE,SDREQPTR40986)
.S SUBIENS="+2,+1,"
.D BLDNEWATTMPT(.FDA,SUBIENS,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DUZ,DTTMENTERED,LEFTMSG,1)
; if there is already a contactien, only build the Date/Time of contact subfile (#409.863) for filing
I CONTACTIEN D
.S SUBIENS="+1,"_CONTACTIEN_","
.S SEQUENCE=$O(^SDEC(409.86,CONTACTIEN,1,9999),-1)+1
.D BLDNEWATTMPT(.FDA,SUBIENS,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DUZ,DTTMENTERED,LEFTMSG,SEQUENCE)
D UPDATE^DIE(,"FDA","NEWIEN","FILERR") K FDA
I $D(FILERR) D Q
.D ERRLOG^SDESJSON(.ERRORS,52,$G(FILERR("DIERR",1,"TEXT",1)))
.S ERRORS("Contact",1)=""
.D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
I CONTACTIEN D
.S NEWCONTATTMTIEN=$G(NEWIEN(1))
I 'CONTACTIEN D
.S CONTACTIEN=$G(NEWIEN(1))
.S NEWCONTATTMTIEN=$G(NEWIEN(2))
; Update the preferred date/PID date if it is different than the request pid date
I PREFDATE'=$$GET1^DIQ(409.68,CONTACTIEN,2,"I") D
.S FDA(409.68,CONTACTIEN_",",2)=PREFDATE D FILE^DIE(,"FDA") K FDA
D BLDCONTACT(.NEWCONTACT,CONTACTIEN,CLINIC)
I '$D(NEWCONTACT) S NEWCONTACT("Contact",1)="" D BUILDJSON^SDESBUILDJSON(.RESULT,.CONTACTS) Q
D DISPMULT(.NEWCONTACT,CONTACTIEN,CLINIC)
D BUILDJSON^SDESBUILDJSON(.RESULT,.NEWCONTACT)
Q
; return the contact ien based on the full pointer reference
GETCONTIEN(ERRORS,REQIEN,REQTYPE) ;
N TRGTFILE,TRGTFLD,FILEROOT,FULLREF,CONTACTDFN,TRGTDFN,CONTACTIEN,TRGTDFNFLD
S TRGTFILE=$S("^A^RTC^V^"[(U_REQTYPE_U):409.85,"^C^P^"[(U_REQTYPE_U):123,REQTYPE="R":403.5,1:"")
S TRGTDFNFLD=$S(TRGTFILE=409.85!(TRGTFILE="403.5"):.01,TRGTFILE=123:.02,1:"")
S FILEROOT=$$ROOT^DILFD(TRGTFILE)
S FULLREF=REQIEN_";"_$P(FILEROOT,U,2)
I '$L(FULLREF) D Q ""
.D ERRLOG^SDESJSON(.ERRORS,391)
; If this entry doesn't exist, return "", because it is a NEW entry
I '$D(^SDEC(409.86,"REQPTR",FULLREF)) Q ""
S CONTACTIEN=$O(^SDEC(409.86,"REQPTR",FULLREF,"A"),-1)
I 'CONTACTIEN D Q ""
.D ERRLOG^SDESJSON(.ERRORS,392)
S CONTACTDFN=$$GET1^DIQ(409.86,CONTACTIEN,.01,"I")
S TRGTDFN=$$GET1^DIQ(TRGTFILE,REQIEN,TRGTDFNFLD,"I")
; check for DFN match
I CONTACTDFN'=TRGTDFN D Q ""
.D ERRLOG^SDESJSON(.ERRORS,393)
Q CONTACTIEN
; add a new entry SDEC CONTACTS file (#409.86)
BLDNEWCONT(FDA,IENS,DFN,CLINIC,PREFDATE,REQTYPE,SERVICE,SDREQPTR40986) ;=
S FDA(409.86,IENS,.01)=DFN
S FDA(409.86,IENS,1)=CLINIC
S FDA(409.86,IENS,2)=PREFDATE
S FDA(409.86,IENS,2.1)=REQTYPE
; Main Sequence (2.2) is always set to 1 initially
S FDA(409.86,IENS,2.2)=1
S FDA(409.86,IENS,1.1)=SERVICE
S FDA(409.86,IENS,2.3)=SDREQPTR40986
Q
; add a new entry to the Date/time of contact multiple in the SDEC CONTACTS file (#409.86)
BLDNEWATTMPT(FDA,IENS,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DUZ,DTTMENTERED,LEFTMSG,SEQUENCE) ;
S FDA(409.863,IENS,.01)=DTTMOFCONTACT
S FDA(409.863,IENS,1)=CONTACTTYPE
S FDA(409.863,IENS,2)=COMMENTS
S FDA(409.863,IENS,3)=$G(LEFTMSG)
; The first entry in this subfile will always be 1
S FDA(409.863,IENS,4)=SEQUENCE
S FDA(409.863,IENS,5)=$G(DUZ)
S FDA(409.863,IENS,6)=DTTMENTERED
Q
;
; SDES CONTACT DISPLAY SINGLE
DISPLAY(RESULT,REQTYPE,REQIEN) ;
N ERRORS,CONTACTIEN,RECALLP01,APPTREQP01,CONTACTP01,CONSULTP02,VPTR,CONTACTS
S REQTYPE=$G(REQTYPE),REQIEN=$G(REQIEN)
D VALREQTYPE(.ERRORS,REQTYPE,"^R^A^RTC^C^P^V^")
I $D(ERRORS) S ERRORS("Contact",1)="" D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS) Q
D VALREQIEN(.ERRORS,REQIEN,REQTYPE)
I $D(ERRORS) S ERRORS("Contact",1)="" D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS) Q
S CONTACTIEN=$$GETCONTIEN(.ERRORS,REQIEN,REQTYPE)
I 'CONTACTIEN S ERRORS("Contact",1)="" D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS) Q
S VPTR=$$GET1^DIQ(409.86,CONTACTIEN,2.3,"I")
I $P(VPTR,";")'=REQIEN D Q
.S ERRORS("Contact",1)=""
.D ERRLOG^SDESJSON(.ERRORS,394)
.D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
D BLDCONTACT(.CONTACTS,CONTACTIEN)
I $D(ERRORS) S ERRORS("Contact",1)="" D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS) Q
I '$D(CONTACTS) S CONTACTS("Contact",1)="" D BUILDJSON^SDESBUILDJSON(.RESULT,.CONTACTS) Q
D DISPMULT(.CONTACTS,CONTACTIEN)
D BUILDJSON^SDESBUILDJSON(.RESULT,.CONTACTS)
Q
DISPMULT(RESULT,CONTACTIEN,CLINIC) ;
; RPC: SDES CONTACT MULTI-DISPLAY
N ERRORS,CONTMULT,CIENS,CONTDATA,CCNT,CONTACTS,CONTDATE,DTTMENTERED
S CONTACTIEN=$G(CONTACTIEN)
S CCNT=0
S CONTMULT=0 F S CONTMULT=$O(^SDEC(409.86,CONTACTIEN,1,CONTMULT)) Q:'CONTMULT D
.S CIENS=CONTMULT_","_CONTACTIEN_","
.D GETS^DIQ(409.863,CIENS,"**","IE","CONTDATA","CERR")
.I $D(CERR) K CERR Q
.I '$G(CLINIC) S CLINIC=$$GET1^DIQ(409.86,CONTACTIEN,1,"I")
.S CCNT=CCNT+1
.S CONTDATE=$G(CONTDATA(409.863,CIENS,.01,"I"))
.S CONTDATE=$$FMTISO^SDAMUTDT(CONTDATE,$G(CLINIC))
.S CONTACTS("ContactAttempts",CCNT,"DateTimeOfContact")=CONTDATE
.S CONTACTS("ContactAttempts",CCNT,"Type")=$G(CONTDATA(409.863,CIENS,1,"E"))
.S CONTACTS("ContactAttempts",CCNT,"Comments")=$G(CONTDATA(409.863,CIENS,2,"E"))
.S CONTACTS("ContactAttempts",CCNT,"LeftMessage")=$G(CONTDATA(409.863,CIENS,3,"E"))
.S CONTACTS("ContactAttempts",CCNT,"Sequence")=$G(CONTDATA(409.863,CIENS,4,"E"))
.S CONTACTS("ContactAttempts",CCNT,"EnteredByName")=$G(CONTDATA(409.863,CIENS,5,"E"))
.S CONTACTS("ContactAttempts",CCNT,"EnteredByIEN")=$G(CONTDATA(409.863,CIENS,5,"I"))
.S CONTACTS("ContactAttempts",CCNT,"EnteredBySecID")=$$GET1^DIQ(200,$G(CONTDATA(409.863,CIENS,5,"I")),205.1,"E")
.S DTTMENTERED=$$FMTISO^SDAMUTDT($G(CONTDATA(409.863,CIENS,6,"I")),$G(CLINIC))
.S CONTACTS("ContactAttempts",CCNT,"DateTimeEntered")=DTTMENTERED
.K CONTDATA
I '$D(CONTACTS) S CONTACTS("ContactAttempts",1)=""
M RESULT=CONTACTS
Q
BLDCONTACT(RESULT,IEN,CLINIC) ;
N F,IENS,ERR,PREFDATE,STOPIEN
S F=409.86,IENS=IEN_","
D GETS^DIQ(409.86,IENS,"**","IE","CONTDATA","ERR")
Q:$D(ERR)
I '$G(CLINIC) S CLINIC=$G(CONTDATA(F,IENS,1,"I"))
S PREFDATE=$$FMTISO^SDAMUTDT($G(CONTDATA(F,IENS,2,"I")),$G(CLINIC))
I PREFDATE<0 S PREFDATE=""
S RESULT("Contact","ID")=$P(IENS,",")
S RESULT("Contact","Patient")=$G(CONTDATA(F,IENS,.01,"I"))
S RESULT("Contact","Clinic")=$G(CONTDATA(F,IENS,1,"I"))
S STOPIEN=$$GET1^DIQ(44,CLINIC,8,"I")
S RESULT("Contact","ClinicStopCodeAMIS")=$$STOPCODETOAMIS^SDESUTIL(STOPIEN)
S RESULT("Contact","PreferredDate")=PREFDATE
S RESULT("Contact","RequestType")=$G(CONTDATA(F,IENS,2.1,"I"))
S RESULT("Contact","MainSequence")=$G(CONTDATA(F,IENS,2.2,"I"))
S RESULT("Contact","Service")=$G(CONTDATA(F,IENS,1.1,"I"))
S RESULT("Contact","RequestPointer")=$G(CONTDATA(F,IENS,2.3,"I"))
K CONTDATA
Q
; RECALLREQPTR is needed to find the old CONTACT entry tied to a RECALL REMINDER and re-point it to the new entry
; NEWREQLINK is ONLY passed in if this was a recall request that is being reopened as an appointment request
; REQIEN is the 409.85 request ien for CONSULTS and APPT type records
UPDCONTSEQ(DFN,REQIEN,NEWREQLINK,RECALLREQPTR) ; update contact attempts main sequence
N IEN40986,REC409860,FOUND,SDECFDA,REC40986PTR
S IEN40986="",FOUND=0
F S IEN40986=$O(^SDEC(409.86,"B",DFN,IEN40986)) Q:IEN40986=""!(FOUND) D
.S REC40986PTR=$P($$GET1^DIQ(409.86,IEN40986,2.3,"I"),";")
.I $G(RECALLREQPTR),$G(RECALLREQPTR)'=+REC40986PTR Q
.I '$G(RECALLREQPTR),REQIEN'=REC40986PTR Q
.K SDECFDA
.S SDECFDA(409.86,IEN40986_",",2.2)=$O(^SDEC(409.86,IEN40986,1,9999),-1)+1
.I $G(NEWREQLINK)]"" D
..S SDECFDA(409.86,IEN40986_",",2.1)="A"
..S SDECFDA(409.86,IEN40986_",",2.3)=NEWREQLINK
.D FILE^DIE("","SDECFDA") K SDECFDA
.S FOUND=1
Q
; validate clinic
VALIDATECLINIC(ERRORS,CLINICIEN) ;
I '$D(^SC(CLINICIEN,0)) D ERRLOG^SDESJSON(.ERRORS,19) Q
Q
; validate contact request type
VALREQTYPE(ERRORS,REQTYPE,RESTRICT2LIST) ;
N RESULTS,CONT,CODE,INTCODE,FOUND
I REQTYPE="" D ERRLOG^SDESJSON(.ERRORS,395)
D FIELD^DID(409.86,2.1,"","SET OF CODES","RESULTS")
S FOUND=0
F CONT=1:1:$L(RESULTS("SET OF CODES"),";") D Q:FOUND
.S CODE=$P(RESULTS("SET OF CODES"),";",CONT) Q:'$L(CODE)
.S INTCODE=$P(CODE,":")
.I $G(RESTRICT2LIST)]"",RESTRICT2LIST'[(U_INTCODE_U) Q
.I REQTYPE=INTCODE S FOUND=1 Q
I 'FOUND D ERRLOG^SDESJSON(.ERRORS,396)
Q
; validate service
VALSERVICE(ERRORS,SERVICE) ;
I '$D(^DIC(40.7,SERVICE)) D ERRLOG^SDESJSON(.ERRORS,397)
Q
; validate request ien
VALREQIEN(ERRORS,REQIEN,REQTYPE) ;
I REQIEN="" D ERRLOG^SDESJSON(.ERRORS,3) Q
I (REQTYPE="A")!(REQTYPE="RTC")!(REQTYPE="V"),'$D(^SDEC(409.85,REQIEN)) D ERRLOG^SDESJSON(.ERRORS,4) Q
I (REQTYPE="C")!(REQTYPE="P"),'$D(^GMR(123,REQIEN)) D ERRLOG^SDESJSON(.ERRORS,4) Q
I REQTYPE="R",'$D(^SD(403.5,REQIEN)) D ERRLOG^SDESJSON(.ERRORS,4) Q
Q
; validate contact ien
VALIDATECONTIEN(ERRORS,CONTACTIEN) ;
I CONTACTIEN="" D ERRLOG^SDESJSON(.ERRORS,398) Q
I '$D(^SDEC(409.86,CONTACTIEN)) D ERRLOG^SDESJSON(.ERRORS,399) Q
Q
VALCONTTYPE(ERRORS,TYPE) ;
N RESULTS,CONT,CODE,INTCODE,FOUND,CODEINC,CODESET,FULLCODE
I TYPE="" D ERRLOG^SDESJSON(.ERRORS,400)
D FIELD^DID(409.863,1,"","SET OF CODES","RESULTS")
S CODESET=$G(RESULTS("SET OF CODES"))
S FOUND=0
F CODEINC=1:1:$L(CODESET,";") D Q:FOUND
.S FULLCODE=$P(CODESET,";",CODEINC)
.S INTCODE=$P(FULLCODE,":")
.Q:INTCODE'=TYPE
.S FOUND=1
I 'FOUND D ERRLOG^SDESJSON(.ERRORS,401)
Q
; FILE - file where the set of codes field lives
; FLD - set of codes field
; VALUE - value to validate
; TEXT - meaningful sentence predicate to return. This will be proceeded by 'Missing set of codes value' or "Invalid set of codes value"
; - (i.e, contact attempt type, appointment type)
VALSETOFCODES(ERRORS,VALUE,FILE,FLD,TEXT) ;
N RESULTS,CONT,CODE,INTCODE,FOUND,RESULTS,ITEM
I VALUE="" D ERRLOG^SDESJSON(.ERRORS,52,"Missing set of codes value: "_TEXT_".") Q
D FIELD^DID(FILE,FLD,"","SET OF CODES","RESULTS")
S FOUND=0
F ITEM=1:1:$L(RESULTS("SET OF CODES"),";") D Q:FOUND
.S CODE=$P(RESULTS("SET OF CODES"),";",ITEM) Q:'$L(CODE)
.S INTCODE=$P(CODE,":")
.I VALUE=INTCODE S FOUND=1 Q
I 'FOUND D ERRLOG^SDESJSON(.ERRORS,52,"Invalid set of codes value: "_TEXT_": '"_VALUE_"'.")
Q
VALTEXTINPUT(ERRORS,COMMENTS,FILE,FLD,REQUIRED) ;
N X,INPUTCHK,RESULTS,LABEL,HELPTEXT
D FIELD^DID(FILE,FLD,"","INPUT TRANSFORM;HELP-PROMPT;LABEL","RESULTS")
S INPUTCHK=$G(RESULTS("INPUT TRANSFORM"))
S HELPTEXT=$G(RESULTS("HELP-PROMPT"))
S LABEL=$G(RESULTS("LABEL"))
I $G(REQUIRED),'$L($G(COMMENTS)) D ERRLOG^SDESJSON(.ERRORS,52,"Missing field: "_$S($L($G(LABEL)):LABEL_".",1:"Unknown Text Field.")) Q
S X=COMMENTS
X INPUTCHK
I '$D(X) D ERRLOG^SDESJSON(.ERRORS,52,HELPTEXT)
Q
VALCONTACTIEN(ERRORS,IEN) ;
I 'IEN D ERRLOG^SDESJSON(.ERRORS,398) Q
I '$D(^SDEC(409.86,IEN)) D ERRLOG^SDESJSON(.ERRORS,399)
Q
VALLEFTMSG(ERRORS,LEFTMSG) ;
I LEFTMSG'=0,LEFTMSG'=1 D ERRLOG^SDESJSON(.ERRORS,402)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCONTACTS 15117 printed Apr 09, 2024@21:52:19 Page 2
SDESCONTACTS ;ALB/BWF - VISTA SCHEDULING CONTACT RPCS ;JUL 18, 2023
+1 ;;5.3;Scheduling;**835,837,845,851**;Aug 13, 1993;Build 10
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 QUIT
+4 ; RPC: SDES CONTACT NEW
+5 ; INPUT:
+6 ;CONTACT("CLINIC")=CLINIC IEN
+7 ;- Clinic IEN from the HOSPITAL LOCATION FILE (#44
+8 ;CONTACT("COMMENTS")=COMMENTS
+9 ;- Free text comments (1-80 characters)
+10 ;CONTACT("CONTACTIEN")=CONTACT IEN
+11 ;- IEN of the main contact entry in the SDEC CONTACT file (#409.86)
+12 ;CONTACT("CONTACTTYPE")=CONTACT TYPE
+13 ;- Contact Type (C - Call, L - Letter, E - Email, T - Text, S - Secure messaging)
+14 ;CONTACT("DFN")=PATIENT DFN
+15 ;- Pointer to the PATIENT file (#2)
+16 ;CONTACT("DTTMENTERED")=DATE/TIME ENTERED (ISO FORMAT)
+17 ;- ISO Date/Time
+18 ;CONTACT("DTTMOFCONTACT")=DATE/TIME OF CONTACT (ISO FORMAT)
+19 ;- ISO Date/Time
+20 ;CONTACT("LEFTMESSAGE")=0 for no, 1 for yes
+21 ;CONTACT("PREFDATE")=PREFERRED DATE (ISO FORMAT)
+22 ;- ISO Date
+23 ;CONTACT("REQTYPE")=REQUEST TYPE
+24 ;- Request Type (A - APPT, R - RECALL, C - CONSULT)
+25 ;CONTACT("REQUESTIEN")=REQUEST IEN
+26 ;- Request IEN (Variable pointer) based on the request type
+27 ; A - SDEC APPT REQUEST (#409.85)
+28 ; C - REQUEST/CONSULTATION file (#123)
+29 ; R - RECALL REQUEST file (#403.5)
+30 ;CONTACT("SERVICE")=SERVICE
+31 ;- Pointer to the CLINIC STOP file (#40.7)
+32 ;
ADDUPD(RESULT,CONTACT) ;
+1 NEW ERRORS,DFN,CLINIC,PREFDATE,REQTYPE,SERVICE,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DTTMENTERED,REQUESTIEN,NEWCONTACT
+2 NEW NEWIEN,SDREQPTR40986,REQTYPE40985,FILERR,FDA,NEWCONTIEN,SUBIENS,CONTACTIEN,SEQUENCE,LEFTMSG,NEWCONTATTMTIEN
+3 SET DFN=$GET(CONTACT("DFN"))
+4 SET CLINIC=$GET(CONTACT("CLINIC"))
+5 SET PREFDATE=""
+6 SET REQTYPE=$GET(CONTACT("REQTYPE"))
+7 SET SERVICE=$GET(CONTACT("SERVICE"))
+8 SET DTTMOFCONTACT=$GET(CONTACT("DTTMOFCONTACT"))
+9 SET CONTACTTYPE=$GET(CONTACT("CONTACTTYPE"))
+10 SET COMMENTS=$GET(CONTACT("COMMENTS"))
+11 SET DTTMENTERED=$GET(CONTACT("DTTMENTERED"))
+12 SET REQUESTIEN=$GET(CONTACT("REQUESTIEN"))
+13 SET LEFTMSG=$GET(CONTACT("LEFTMESSAGE"))
+14 IF LEFTMSG=""
SET LEFTMSG=0
+15 DO VALIDATEDFN^SDESINPUTVALUTL(.ERRORS,DFN)
+16 IF CLINIC'=""
DO VALIDATECLINIC(.ERRORS,CLINIC)
+17 IF $DATA(ERRORS)
SET ERRORS("Contact",1)=""
DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
QUIT
+18 DO VALREQTYPE(.ERRORS,REQTYPE,"^R^A^RTC^C^P^V^")
+19 IF $GET(SERVICE)]""
DO VALSERVICE(.ERRORS,SERVICE)
+20 IF $GET(LEFTMSG)'=""
DO VALLEFTMSG(.ERRORS,LEFTMSG)
+21 SET DTTMOFCONTACT=$$VALDATE2^SDESVALUTIL(.ERRORS,DTTMOFCONTACT,CLINIC,389,390)
+22 ; validate text input based on field definition
+23 DO VALTEXTINPUT(.ERRORS,COMMENTS,409.863,2,1)
+24 SET DTTMENTERED=$$VALDATE2^SDESVALUTIL(.ERRORS,DTTMENTERED,CLINIC,387,388)
+25 IF $DATA(ERRORS)
SET ERRORS("Contact",1)=""
DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
QUIT
+26 DO VALREQIEN(.ERRORS,REQUESTIEN,REQTYPE)
+27 DO VALSETOFCODES(.ERRORS,CONTACTTYPE,409.863,1,"Contact Type")
+28 SET CONTACTIEN=$$GETCONTIEN(.ERRORS,REQUESTIEN,REQTYPE)
+29 IF $DATA(ERRORS)
SET ERRORS("Contact",1)=""
DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
QUIT
+30 IF REQUESTIEN
Begin DoDot:1
+31 SET SDREQPTR40986=""
+32 IF (REQTYPE="A")!(REQTYPE="RTC")!(REQTYPE="V")
Begin DoDot:2
+33 if $$GET1^DIQ(409.85,REQUESTIEN,.01,"I")'=DFN
QUIT
+34 SET REQTYPE40985=$$GET1^DIQ(409.85,REQUESTIEN,4,"I")
+35 IF REQTYPE40985'="APPT"
IF REQTYPE40985'="RTC"
IF REQTYPE40985'="VETERAN"
QUIT
+36 SET SDREQPTR40986=REQUESTIEN_";"_"SDEC(409.85,"
+37 SET PREFDATE=$$GET1^DIQ(409.85,REQUESTIEN,22,"I")
End DoDot:2
+38 if SDREQPTR40986'=""
QUIT
+39 IF REQTYPE="C"!(REQTYPE="P")
Begin DoDot:2
+40 if $$GET1^DIQ(123,REQUESTIEN,.02,"I")'=DFN
QUIT
+41 if $$GET1^DIQ(123,REQUESTIEN,13,"I")'=REQTYPE
QUIT
+42 if CLINIC'=""&(CLINIC'=$$GET1^DIQ(123,REQUESTIEN,.04,"I"))
QUIT
+43 SET SDREQPTR40986=REQUESTIEN_";"_"GMR(123,"
+44 IF $DATA(^SDEC(409.87,"B",REQUESTIEN))
SET PREFDATE=$$GETPID^SDECCONSJSON(REQUESTIEN)
+45 IF '$DATA(^SDEC(409.87,"B",REQUESTIEN))!(PREFDATE="")
SET PREFDATE=$$GET1^DIQ(123,REQUESTIEN,17,"I")
End DoDot:2
+46 if SDREQPTR40986'=""
QUIT
+47 IF REQTYPE="R"
Begin DoDot:2
+48 if $$GET1^DIQ(403.5,REQUESTIEN,.01,"I")'=DFN
QUIT
+49 IF CLINIC'=""
IF $$GET1^DIQ(403.5,REQUESTIEN,4.5,"I")'=CLINIC
QUIT
+50 SET SDREQPTR40986=REQUESTIEN_";"_"SD(403.5,"
+51 SET PREFDATE=$$GET1^DIQ(403.5,REQUESTIEN,5,"I")
End DoDot:2
End DoDot:1
+52 IF $GET(SDREQPTR40986)=""
Begin DoDot:1
+53 DO ERRLOG^SDESJSON(.ERRORS,394)
+54 SET ERRORS("Contact",1)=""
+55 DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
End DoDot:1
QUIT
+56 IF $GET(PREFDATE)=""
Begin DoDot:1
+57 DO ERRLOG^SDESJSON(.ERRORS,408)
End DoDot:1
+58 IF $DATA(ERRORS)
Begin DoDot:1
+59 SET ERRORS("Contact",1)=""
+60 DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
End DoDot:1
QUIT
+61 IF 'CONTACTIEN
Begin DoDot:1
+62 DO BLDNEWCONT(.FDA,"+1,",DFN,CLINIC,PREFDATE,REQTYPE,SERVICE,SDREQPTR40986)
+63 SET SUBIENS="+2,+1,"
+64 DO BLDNEWATTMPT(.FDA,SUBIENS,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DUZ,DTTMENTERED,LEFTMSG,1)
End DoDot:1
+65 ; if there is already a contactien, only build the Date/Time of contact subfile (#409.863) for filing
+66 IF CONTACTIEN
Begin DoDot:1
+67 SET SUBIENS="+1,"_CONTACTIEN_","
+68 SET SEQUENCE=$ORDER(^SDEC(409.86,CONTACTIEN,1,9999),-1)+1
+69 DO BLDNEWATTMPT(.FDA,SUBIENS,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DUZ,DTTMENTERED,LEFTMSG,SEQUENCE)
End DoDot:1
+70 DO UPDATE^DIE(,"FDA","NEWIEN","FILERR")
KILL FDA
+71 IF $DATA(FILERR)
Begin DoDot:1
+72 DO ERRLOG^SDESJSON(.ERRORS,52,$GET(FILERR("DIERR",1,"TEXT",1)))
+73 SET ERRORS("Contact",1)=""
+74 DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
End DoDot:1
QUIT
+75 IF CONTACTIEN
Begin DoDot:1
+76 SET NEWCONTATTMTIEN=$GET(NEWIEN(1))
End DoDot:1
+77 IF 'CONTACTIEN
Begin DoDot:1
+78 SET CONTACTIEN=$GET(NEWIEN(1))
+79 SET NEWCONTATTMTIEN=$GET(NEWIEN(2))
End DoDot:1
+80 ; Update the preferred date/PID date if it is different than the request pid date
+81 IF PREFDATE'=$$GET1^DIQ(409.68,CONTACTIEN,2,"I")
Begin DoDot:1
+82 SET FDA(409.68,CONTACTIEN_",",2)=PREFDATE
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:1
+83 DO BLDCONTACT(.NEWCONTACT,CONTACTIEN,CLINIC)
+84 IF '$DATA(NEWCONTACT)
SET NEWCONTACT("Contact",1)=""
DO BUILDJSON^SDESBUILDJSON(.RESULT,.CONTACTS)
QUIT
+85 DO DISPMULT(.NEWCONTACT,CONTACTIEN,CLINIC)
+86 DO BUILDJSON^SDESBUILDJSON(.RESULT,.NEWCONTACT)
+87 QUIT
+88 ; return the contact ien based on the full pointer reference
GETCONTIEN(ERRORS,REQIEN,REQTYPE) ;
+1 NEW TRGTFILE,TRGTFLD,FILEROOT,FULLREF,CONTACTDFN,TRGTDFN,CONTACTIEN,TRGTDFNFLD
+2 SET TRGTFILE=$SELECT("^A^RTC^V^"[(U_REQTYPE_U):409.85,"^C^P^"[(U_REQTYPE_U):123,REQTYPE="R":403.5,1:"")
+3 SET TRGTDFNFLD=$SELECT(TRGTFILE=409.85!(TRGTFILE="403.5"):.01,TRGTFILE=123:.02,1:"")
+4 SET FILEROOT=$$ROOT^DILFD(TRGTFILE)
+5 SET FULLREF=REQIEN_";"_$PIECE(FILEROOT,U,2)
+6 IF '$LENGTH(FULLREF)
Begin DoDot:1
+7 DO ERRLOG^SDESJSON(.ERRORS,391)
End DoDot:1
QUIT ""
+8 ; If this entry doesn't exist, return "", because it is a NEW entry
+9 IF '$DATA(^SDEC(409.86,"REQPTR",FULLREF))
QUIT ""
+10 SET CONTACTIEN=$ORDER(^SDEC(409.86,"REQPTR",FULLREF,"A"),-1)
+11 IF 'CONTACTIEN
Begin DoDot:1
+12 DO ERRLOG^SDESJSON(.ERRORS,392)
End DoDot:1
QUIT ""
+13 SET CONTACTDFN=$$GET1^DIQ(409.86,CONTACTIEN,.01,"I")
+14 SET TRGTDFN=$$GET1^DIQ(TRGTFILE,REQIEN,TRGTDFNFLD,"I")
+15 ; check for DFN match
+16 IF CONTACTDFN'=TRGTDFN
Begin DoDot:1
+17 DO ERRLOG^SDESJSON(.ERRORS,393)
End DoDot:1
QUIT ""
+18 QUIT CONTACTIEN
+19 ; add a new entry SDEC CONTACTS file (#409.86)
BLDNEWCONT(FDA,IENS,DFN,CLINIC,PREFDATE,REQTYPE,SERVICE,SDREQPTR40986) ;=
+1 SET FDA(409.86,IENS,.01)=DFN
+2 SET FDA(409.86,IENS,1)=CLINIC
+3 SET FDA(409.86,IENS,2)=PREFDATE
+4 SET FDA(409.86,IENS,2.1)=REQTYPE
+5 ; Main Sequence (2.2) is always set to 1 initially
+6 SET FDA(409.86,IENS,2.2)=1
+7 SET FDA(409.86,IENS,1.1)=SERVICE
+8 SET FDA(409.86,IENS,2.3)=SDREQPTR40986
+9 QUIT
+10 ; add a new entry to the Date/time of contact multiple in the SDEC CONTACTS file (#409.86)
BLDNEWATTMPT(FDA,IENS,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DUZ,DTTMENTERED,LEFTMSG,SEQUENCE) ;
+1 SET FDA(409.863,IENS,.01)=DTTMOFCONTACT
+2 SET FDA(409.863,IENS,1)=CONTACTTYPE
+3 SET FDA(409.863,IENS,2)=COMMENTS
+4 SET FDA(409.863,IENS,3)=$GET(LEFTMSG)
+5 ; The first entry in this subfile will always be 1
+6 SET FDA(409.863,IENS,4)=SEQUENCE
+7 SET FDA(409.863,IENS,5)=$GET(DUZ)
+8 SET FDA(409.863,IENS,6)=DTTMENTERED
+9 QUIT
+10 ;
+11 ; SDES CONTACT DISPLAY SINGLE
DISPLAY(RESULT,REQTYPE,REQIEN) ;
+1 NEW ERRORS,CONTACTIEN,RECALLP01,APPTREQP01,CONTACTP01,CONSULTP02,VPTR,CONTACTS
+2 SET REQTYPE=$GET(REQTYPE)
SET REQIEN=$GET(REQIEN)
+3 DO VALREQTYPE(.ERRORS,REQTYPE,"^R^A^RTC^C^P^V^")
+4 IF $DATA(ERRORS)
SET ERRORS("Contact",1)=""
DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
QUIT
+5 DO VALREQIEN(.ERRORS,REQIEN,REQTYPE)
+6 IF $DATA(ERRORS)
SET ERRORS("Contact",1)=""
DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
QUIT
+7 SET CONTACTIEN=$$GETCONTIEN(.ERRORS,REQIEN,REQTYPE)
+8 IF 'CONTACTIEN
SET ERRORS("Contact",1)=""
DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
QUIT
+9 SET VPTR=$$GET1^DIQ(409.86,CONTACTIEN,2.3,"I")
+10 IF $PIECE(VPTR,";")'=REQIEN
Begin DoDot:1
+11 SET ERRORS("Contact",1)=""
+12 DO ERRLOG^SDESJSON(.ERRORS,394)
+13 DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
End DoDot:1
QUIT
+14 DO BLDCONTACT(.CONTACTS,CONTACTIEN)
+15 IF $DATA(ERRORS)
SET ERRORS("Contact",1)=""
DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
QUIT
+16 IF '$DATA(CONTACTS)
SET CONTACTS("Contact",1)=""
DO BUILDJSON^SDESBUILDJSON(.RESULT,.CONTACTS)
QUIT
+17 DO DISPMULT(.CONTACTS,CONTACTIEN)
+18 DO BUILDJSON^SDESBUILDJSON(.RESULT,.CONTACTS)
+19 QUIT
DISPMULT(RESULT,CONTACTIEN,CLINIC) ;
+1 ; RPC: SDES CONTACT MULTI-DISPLAY
+2 NEW ERRORS,CONTMULT,CIENS,CONTDATA,CCNT,CONTACTS,CONTDATE,DTTMENTERED
+3 SET CONTACTIEN=$GET(CONTACTIEN)
+4 SET CCNT=0
+5 SET CONTMULT=0
FOR
SET CONTMULT=$ORDER(^SDEC(409.86,CONTACTIEN,1,CONTMULT))
if 'CONTMULT
QUIT
Begin DoDot:1
+6 SET CIENS=CONTMULT_","_CONTACTIEN_","
+7 DO GETS^DIQ(409.863,CIENS,"**","IE","CONTDATA","CERR")
+8 IF $DATA(CERR)
KILL CERR
QUIT
+9 IF '$GET(CLINIC)
SET CLINIC=$$GET1^DIQ(409.86,CONTACTIEN,1,"I")
+10 SET CCNT=CCNT+1
+11 SET CONTDATE=$GET(CONTDATA(409.863,CIENS,.01,"I"))
+12 SET CONTDATE=$$FMTISO^SDAMUTDT(CONTDATE,$GET(CLINIC))
+13 SET CONTACTS("ContactAttempts",CCNT,"DateTimeOfContact")=CONTDATE
+14 SET CONTACTS("ContactAttempts",CCNT,"Type")=$GET(CONTDATA(409.863,CIENS,1,"E"))
+15 SET CONTACTS("ContactAttempts",CCNT,"Comments")=$GET(CONTDATA(409.863,CIENS,2,"E"))
+16 SET CONTACTS("ContactAttempts",CCNT,"LeftMessage")=$GET(CONTDATA(409.863,CIENS,3,"E"))
+17 SET CONTACTS("ContactAttempts",CCNT,"Sequence")=$GET(CONTDATA(409.863,CIENS,4,"E"))
+18 SET CONTACTS("ContactAttempts",CCNT,"EnteredByName")=$GET(CONTDATA(409.863,CIENS,5,"E"))
+19 SET CONTACTS("ContactAttempts",CCNT,"EnteredByIEN")=$GET(CONTDATA(409.863,CIENS,5,"I"))
+20 SET CONTACTS("ContactAttempts",CCNT,"EnteredBySecID")=$$GET1^DIQ(200,$GET(CONTDATA(409.863,CIENS,5,"I")),205.1,"E")
+21 SET DTTMENTERED=$$FMTISO^SDAMUTDT($GET(CONTDATA(409.863,CIENS,6,"I")),$GET(CLINIC))
+22 SET CONTACTS("ContactAttempts",CCNT,"DateTimeEntered")=DTTMENTERED
+23 KILL CONTDATA
End DoDot:1
+24 IF '$DATA(CONTACTS)
SET CONTACTS("ContactAttempts",1)=""
+25 MERGE RESULT=CONTACTS
+26 QUIT
BLDCONTACT(RESULT,IEN,CLINIC) ;
+1 NEW F,IENS,ERR,PREFDATE,STOPIEN
+2 SET F=409.86
SET IENS=IEN_","
+3 DO GETS^DIQ(409.86,IENS,"**","IE","CONTDATA","ERR")
+4 if $DATA(ERR)
QUIT
+5 IF '$GET(CLINIC)
SET CLINIC=$GET(CONTDATA(F,IENS,1,"I"))
+6 SET PREFDATE=$$FMTISO^SDAMUTDT($GET(CONTDATA(F,IENS,2,"I")),$GET(CLINIC))
+7 IF PREFDATE<0
SET PREFDATE=""
+8 SET RESULT("Contact","ID")=$PIECE(IENS,",")
+9 SET RESULT("Contact","Patient")=$GET(CONTDATA(F,IENS,.01,"I"))
+10 SET RESULT("Contact","Clinic")=$GET(CONTDATA(F,IENS,1,"I"))
+11 SET STOPIEN=$$GET1^DIQ(44,CLINIC,8,"I")
+12 SET RESULT("Contact","ClinicStopCodeAMIS")=$$STOPCODETOAMIS^SDESUTIL(STOPIEN)
+13 SET RESULT("Contact","PreferredDate")=PREFDATE
+14 SET RESULT("Contact","RequestType")=$GET(CONTDATA(F,IENS,2.1,"I"))
+15 SET RESULT("Contact","MainSequence")=$GET(CONTDATA(F,IENS,2.2,"I"))
+16 SET RESULT("Contact","Service")=$GET(CONTDATA(F,IENS,1.1,"I"))
+17 SET RESULT("Contact","RequestPointer")=$GET(CONTDATA(F,IENS,2.3,"I"))
+18 KILL CONTDATA
+19 QUIT
+20 ; RECALLREQPTR is needed to find the old CONTACT entry tied to a RECALL REMINDER and re-point it to the new entry
+21 ; NEWREQLINK is ONLY passed in if this was a recall request that is being reopened as an appointment request
+22 ; REQIEN is the 409.85 request ien for CONSULTS and APPT type records
UPDCONTSEQ(DFN,REQIEN,NEWREQLINK,RECALLREQPTR) ; update contact attempts main sequence
+1 NEW IEN40986,REC409860,FOUND,SDECFDA,REC40986PTR
+2 SET IEN40986=""
SET FOUND=0
+3 FOR
SET IEN40986=$ORDER(^SDEC(409.86,"B",DFN,IEN40986))
if IEN40986=""!(FOUND)
QUIT
Begin DoDot:1
+4 SET REC40986PTR=$PIECE($$GET1^DIQ(409.86,IEN40986,2.3,"I"),";")
+5 IF $GET(RECALLREQPTR)
IF $GET(RECALLREQPTR)'=+REC40986PTR
QUIT
+6 IF '$GET(RECALLREQPTR)
IF REQIEN'=REC40986PTR
QUIT
+7 KILL SDECFDA
+8 SET SDECFDA(409.86,IEN40986_",",2.2)=$ORDER(^SDEC(409.86,IEN40986,1,9999),-1)+1
+9 IF $GET(NEWREQLINK)]""
Begin DoDot:2
+10 SET SDECFDA(409.86,IEN40986_",",2.1)="A"
+11 SET SDECFDA(409.86,IEN40986_",",2.3)=NEWREQLINK
End DoDot:2
+12 DO FILE^DIE("","SDECFDA")
KILL SDECFDA
+13 SET FOUND=1
End DoDot:1
+14 QUIT
+15 ; validate clinic
VALIDATECLINIC(ERRORS,CLINICIEN) ;
+1 IF '$DATA(^SC(CLINICIEN,0))
DO ERRLOG^SDESJSON(.ERRORS,19)
QUIT
+2 QUIT
+3 ; validate contact request type
VALREQTYPE(ERRORS,REQTYPE,RESTRICT2LIST) ;
+1 NEW RESULTS,CONT,CODE,INTCODE,FOUND
+2 IF REQTYPE=""
DO ERRLOG^SDESJSON(.ERRORS,395)
+3 DO FIELD^DID(409.86,2.1,"","SET OF CODES","RESULTS")
+4 SET FOUND=0
+5 FOR CONT=1:1:$LENGTH(RESULTS("SET OF CODES"),";")
Begin DoDot:1
+6 SET CODE=$PIECE(RESULTS("SET OF CODES"),";",CONT)
if '$LENGTH(CODE)
QUIT
+7 SET INTCODE=$PIECE(CODE,":")
+8 IF $GET(RESTRICT2LIST)]""
IF RESTRICT2LIST'[(U_INTCODE_U)
QUIT
+9 IF REQTYPE=INTCODE
SET FOUND=1
QUIT
End DoDot:1
if FOUND
QUIT
+10 IF 'FOUND
DO ERRLOG^SDESJSON(.ERRORS,396)
+11 QUIT
+12 ; validate service
VALSERVICE(ERRORS,SERVICE) ;
+1 IF '$DATA(^DIC(40.7,SERVICE))
DO ERRLOG^SDESJSON(.ERRORS,397)
+2 QUIT
+3 ; validate request ien
VALREQIEN(ERRORS,REQIEN,REQTYPE) ;
+1 IF REQIEN=""
DO ERRLOG^SDESJSON(.ERRORS,3)
QUIT
+2 IF (REQTYPE="A")!(REQTYPE="RTC")!(REQTYPE="V")
IF '$DATA(^SDEC(409.85,REQIEN))
DO ERRLOG^SDESJSON(.ERRORS,4)
QUIT
+3 IF (REQTYPE="C")!(REQTYPE="P")
IF '$DATA(^GMR(123,REQIEN))
DO ERRLOG^SDESJSON(.ERRORS,4)
QUIT
+4 IF REQTYPE="R"
IF '$DATA(^SD(403.5,REQIEN))
DO ERRLOG^SDESJSON(.ERRORS,4)
QUIT
+5 QUIT
+6 ; validate contact ien
VALIDATECONTIEN(ERRORS,CONTACTIEN) ;
+1 IF CONTACTIEN=""
DO ERRLOG^SDESJSON(.ERRORS,398)
QUIT
+2 IF '$DATA(^SDEC(409.86,CONTACTIEN))
DO ERRLOG^SDESJSON(.ERRORS,399)
QUIT
+3 QUIT
VALCONTTYPE(ERRORS,TYPE) ;
+1 NEW RESULTS,CONT,CODE,INTCODE,FOUND,CODEINC,CODESET,FULLCODE
+2 IF TYPE=""
DO ERRLOG^SDESJSON(.ERRORS,400)
+3 DO FIELD^DID(409.863,1,"","SET OF CODES","RESULTS")
+4 SET CODESET=$GET(RESULTS("SET OF CODES"))
+5 SET FOUND=0
+6 FOR CODEINC=1:1:$LENGTH(CODESET,";")
Begin DoDot:1
+7 SET FULLCODE=$PIECE(CODESET,";",CODEINC)
+8 SET INTCODE=$PIECE(FULLCODE,":")
+9 if INTCODE'=TYPE
QUIT
+10 SET FOUND=1
End DoDot:1
if FOUND
QUIT
+11 IF 'FOUND
DO ERRLOG^SDESJSON(.ERRORS,401)
+12 QUIT
+13 ; FILE - file where the set of codes field lives
+14 ; FLD - set of codes field
+15 ; VALUE - value to validate
+16 ; TEXT - meaningful sentence predicate to return. This will be proceeded by 'Missing set of codes value' or "Invalid set of codes value"
+17 ; - (i.e, contact attempt type, appointment type)
VALSETOFCODES(ERRORS,VALUE,FILE,FLD,TEXT) ;
+1 NEW RESULTS,CONT,CODE,INTCODE,FOUND,RESULTS,ITEM
+2 IF VALUE=""
DO ERRLOG^SDESJSON(.ERRORS,52,"Missing set of codes value: "_TEXT_".")
QUIT
+3 DO FIELD^DID(FILE,FLD,"","SET OF CODES","RESULTS")
+4 SET FOUND=0
+5 FOR ITEM=1:1:$LENGTH(RESULTS("SET OF CODES"),";")
Begin DoDot:1
+6 SET CODE=$PIECE(RESULTS("SET OF CODES"),";",ITEM)
if '$LENGTH(CODE)
QUIT
+7 SET INTCODE=$PIECE(CODE,":")
+8 IF VALUE=INTCODE
SET FOUND=1
QUIT
End DoDot:1
if FOUND
QUIT
+9 IF 'FOUND
DO ERRLOG^SDESJSON(.ERRORS,52,"Invalid set of codes value: "_TEXT_": '"_VALUE_"'.")
+10 QUIT
VALTEXTINPUT(ERRORS,COMMENTS,FILE,FLD,REQUIRED) ;
+1 NEW X,INPUTCHK,RESULTS,LABEL,HELPTEXT
+2 DO FIELD^DID(FILE,FLD,"","INPUT TRANSFORM;HELP-PROMPT;LABEL","RESULTS")
+3 SET INPUTCHK=$GET(RESULTS("INPUT TRANSFORM"))
+4 SET HELPTEXT=$GET(RESULTS("HELP-PROMPT"))
+5 SET LABEL=$GET(RESULTS("LABEL"))
+6 IF $GET(REQUIRED)
IF '$LENGTH($GET(COMMENTS))
DO ERRLOG^SDESJSON(.ERRORS,52,"Missing field: "_$SELECT($LENGTH($GET(LABEL)):LABEL_".",1:"Unknown Text Field."))
QUIT
+7 SET X=COMMENTS
+8 XECUTE INPUTCHK
+9 IF '$DATA(X)
DO ERRLOG^SDESJSON(.ERRORS,52,HELPTEXT)
+10 QUIT
VALCONTACTIEN(ERRORS,IEN) ;
+1 IF 'IEN
DO ERRLOG^SDESJSON(.ERRORS,398)
QUIT
+2 IF '$DATA(^SDEC(409.86,IEN))
DO ERRLOG^SDESJSON(.ERRORS,399)
+3 QUIT
VALLEFTMSG(ERRORS,LEFTMSG) ;
+1 IF LEFTMSG'=0
IF LEFTMSG'=1
DO ERRLOG^SDESJSON(.ERRORS,402)
+2 QUIT
