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

SDES2CONTACTS.m

Go to the documentation of this file.
SDES2CONTACTS ;ALB/LAB,MCB/TJB,JAS - VISTA SCHEDULING CONTACT SDES2 CONTACT ATTEMPTS ;Aug 28,2024
 ;;5.3;Scheduling;**860,873,878,887**;Aug 13, 1993;Build 7
 ;;Per VHA Directive 6402, this routine should not be modified
 Q
 ;
ADDCONTACT(RESULT,SDCONTEXT,CONTACT) ; RPC: SDEC2 ADD CONTACT ATTEMPT
 N ERRORS,DFN,CLINIC,PREFDATE,REQTYPE,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DTTMENTERED,REQUESTIEN,NEWCONTACT
 N NEWIEN,APPTREQTYPE,FDA,NEWCONTIEN,SUBIENS,CONTACTIEN,SEQUENCE,LEFTMSG,NEWCONTATTMTIEN,VALID
 ;
 D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
 I $D(ERRORS) S ERRORS("Contact",1)="",ERRORS("ContactAttempts")="" D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
 ;
 D REQUESTINFO(.ERRORS,.CONTACT,.APPTREQTYPE,.REQUESTIEN,.REQTYP,.DFN,.CLINIC,.PREFDATE)
 I $D(ERRORS) S ERRORS("Contact",1)="",ERRORS("ContactAttempts")="" D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
 ;
 D ASSIGNVARS(.CONTACT,.REQTYPE,.DTTMOFCONTACT,.COMMENTS,.DTMENTERED,.LEFTMSG,.SDDUZ)
 D VALIDATE(.ERRORS,REQTYPE,.DTTMOFCONTACT,COMMENTS,.DTTMENTERED,LEFTMSG,CONTACTTYPE,CLINIC)
 I $D(ERRORS) S ERRORS("Contact",1)="",ERRORS("ContactAttempts")="" D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
 ;
 D GETCONTACTIEN(.CONTACTIEN,APPTREQTYPE)
 ;
 D:(CONTACTIEN'="") UPDATECONTACT(.RESULT,.FDA,CONTACTIEN,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,SDDUZ,DTTMENTERED,LEFTMSG)
 D:(CONTACTIEN="") CREATECONTACT(.RESULT,.FDA,DFN,CONTACTIEN,CLINIC,PREFDATE,REQTYPE,APPTREQTYPE,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,SDDUZ,DTTMENTERED,LEFTMSG)
 D SAVECONTACT(.ERRORS,.RESULT,.FDA,.NEWIEN)
 D ASSIGNNEWIEN(.NEWCONTACTIEN,.CONTACTIEN,.NEWIEN)
 D BLDRETNINFO(.NEWCONTACT,CONTACTIEN,CLINIC)
 I '$D(NEWCONTACT) S NEWCONTACT("Contact",1)="",ERRORS("ContactAttempts")="" D BUILDJSON^SDES2JSON(.RESULT,.CONTACTS) Q
 D DISPCONTACT(.NEWCONTACT,CONTACTIEN,CLINIC)
 D BUILDJSON^SDES2JSON(.RESULT,.NEWCONTACT)
 Q
 ;
ASSIGNNEWIEN(NEWCONTACTIEN,CONTACTIEN,NEWIEN) ;get the iens that were created during create/update
 S:CONTACTIEN'="" NEWCONTATTMTIEN=$G(NEWIEN(1))
 I CONTACTIEN="" D
 .S CONTACTIEN=$G(NEWIEN(1))
 .S NEWCONTATTMTIEN=$G(NEWIEN(2))
 Q
 ;
GETCONTACTIEN(CONTACTIEN,APPTREQTYPE) ;if a contact attempt already exists, get it's ien
 S CONTACTIEN=""
 S:$D(^SDEC(409.86,"REQPTR",APPTREQTYPE)) CONTACTIEN=$O(^SDEC(409.86,"REQPTR",APPTREQTYPE,"A"),-1)
 Q
 ;
BLDNEWCONT(FDA,IENS,DFN,CLINIC,PREFDATE,REQTYPE,APPTREQTYPE) ; build the new contact attempt record.
 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,2.3)=APPTREQTYPE
 Q
 ;
BLDNEWATTMPT(FDA,IENS,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,SDDUZ,DTTMENTERED,LEFTMSG,SEQUENCE) ;add a new entry to existing contact attempt record.
 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(SDDUZ)
 S FDA(409.863,IENS,6)=DTTMENTERED
 Q
 ;
BLDRETNINFO(RESULT,IEN,CLINIC) ;build return result of contact attempts
 N F,IENS,ERR,PREFDATE,STOPIEN,CONTDATA
 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"))
 N SRVSTRING
 S SRVSTRING=$$GETSRV($G(CONTDATA(F,IENS,2.1,"I")),+$G(CONTDATA(F,IENS,2.3,"I")))
 S RESULT("Contact","Service")=$P($G(SRVSTRING),"^")
 S RESULT("Contact","ServiceName")=$P($G(SRVSTRING),"^",2)
 S RESULT("Contact","RequestPointer")=$G(CONTDATA(F,IENS,2.3,"I"))
 K CONTDATA
 Q
 ;
ASSIGNVARS(CONTACT,REQTYPE,DTTMOFCONTACT,COMMENTS,DTMENTERED,LEFTMSG,SDDUZ) ;assign variables used sent in from CONTACT array
 S DTTMOFCONTACT=$G(CONTACT("DTTMOFCONTACT"))
 S CONTACTTYPE=$G(CONTACT("CONTACTTYPE"))
 S COMMENTS=$G(CONTACT("COMMENTS"))
 S DTTMENTERED=$G(CONTACT("DTTMENTERED"))
 S LEFTMSG=$G(CONTACT("LEFTMESSAGE"))
 S:LEFTMSG="" LEFTMSG=0
 S:$G(SDCONTEXT("USER DUZ"))'="" SDDUZ=$G(SDCONTEXT("USER DUZ"))
 S:$G(SDCONTEXT("USER DUZ"))="" SDDUZ=DUZ
 Q
 ;
VALIDATE(ERRORS,REQTYPE,DTTMOFCONTACT,COMMENTS,DTTMENTERED,LEFTMSG,CONTACTTYPE,CLINIC) ;validate input array values
 D VALFIELD^SDES2VALUTIL(,.ERRORS,409.86,2.1,REQTYPE,,0,395,396)
 D VALFIELD^SDES2VALUTIL(,.ERRORS,409.863,3,LEFTMSG,0,0,,402)
 D VALFIELD^SDES2VALUTIL(,.ERRORS,409.863,2,COMMENTS,0,0)
 D VALFIELD^SDES2VALUTIL(,.ERRORS,409.863,1,CONTACTTYPE,1,0)
 S DTTMOFCONTACT=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,DTTMOFCONTACT,CLINIC,1,389,390) ;
 S DTTMENTERED=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,DTTMENTERED,,1,387,388) ;
 Q
 ;
REQUESTINFO(ERRORS,CONTACT,APPTREQTYPE,REQUESTIEN,REQTYP,DFN,CLINIC,PREFDATE,CONTACTIEN) ;
 ; Given the request ien and request type, return back information needed from request
 N REQTYPEFOUND,VALID
 S REQTYPEFOUND=0
 S REQUESTIEN=$G(CONTACT("REQUESTIEN"))
 S REQTYPE=$G(CONTACT("REQTYPE"))
 I (REQTYPE="A")!(REQTYPE="RTC")!(REQTYPE="V") D
 . D VALFILEIEN^SDES2VALUTIL(.VALID,.ERRORS,409.85,REQUESTIEN,1,0,3,4)
 . Q:'VALID
 . S DFN=$$GET1^DIQ(409.85,REQUESTIEN,.01,"I")
 . S CLINIC=$$GET1^DIQ(409.85,REQUESTIEN,8,"I")
 . S PREFDATE=$$GET1^DIQ(409.85,REQUESTIEN,22,"I")
 . S APPTREQTYPE=REQUESTIEN_";"_"SDEC(409.85,"
 . S REQTYPEFOUND=1
 I (REQTYPE="C")!(REQTYPE="P") D
 . D VALFILEIEN^SDES2VALUTIL(.VALID,.ERRORS,123,REQUESTIEN,1,0,3,4)
 . Q:'VALID
 . S DFN=$$GET1^DIQ(123,REQUESTIEN,.02,"I")
 . S CLINIC=""
 . S:$$GET1^DIQ(123,REQUESTIEN,17,"I")'="" PREFDATE=$$GET1^DIQ(123,REQUESTIEN,17,"I")
 . S:$G(PREFDATE)="" PREFDATE=$$GET1^DIQ(123,REQUESTIEN,.01,"I")
 . S APPTREQTYPE=REQUESTIEN_";"_"GMR(123,"
 . S REQTYPEFOUND=1
 I REQTYPE="R" D
 . D VALFILEIEN^SDES2VALUTIL(.VALID,.ERRORS,403.5,REQUESTIEN,1,0,3,4)
 . Q:'VALID
 . S DFN=$$GET1^DIQ(403.5,REQUESTIEN,.01,"I")
 . S CLINIC=$$GET1^DIQ(403.5,REQUESTIEN,4.5,"I")
 . S PREFDATE=$$GET1^DIQ(403.5,REQUESTIEN,5,"I")
 . S APPTREQTYPE=REQUESTIEN_";"_"SD(403.5,"
 . S REQTYPEFOUND=1
 I '$D(ERRORS)&('REQTYPEFOUND) D ERRLOG^SDES2JSON(.ERRORS,52,"Passed in Request Type invalid or not supported.")
 Q
 ;
CREATECONTACT(RESULT,FDA,DFN,CONTACTIEN,CLINIC,PREFDATE,REQTYPE,APPTREQTYPE,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,SDDUZ,DTTMENTERED,LEFTMSG) ;
 ;create a new contact attempt record
 D BLDNEWCONT(.FDA,"+1,",DFN,CLINIC,PREFDATE,REQTYPE,APPTREQTYPE)
 S SUBIENS="+2,+1,"
 D BLDNEWATTMPT(.FDA,SUBIENS,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,SDDUZ,DTTMENTERED,LEFTMSG,1)
 Q
 ;
UPDATECONTACT(RESULT,FDA,CONTACTIEN,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,SDDUZ,DTTMENTERED,LEFTMSG) ;
 ;update the contact attempt multiple with the new contact data
 S SUBIENS="+1,"_CONTACTIEN_","
 S SEQUENCE=$O(^SDEC(409.86,CONTACTIEN,1,9999),-1)+1
 D BLDNEWATTMPT(.FDA,SUBIENS,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,SDDUZ,DTTMENTERED,LEFTMSG,SEQUENCE)
 Q
 ;
SAVECONTACT(ERRORS,RESULT,FDA,NEWIEN) ;file contact attempt in 409.86 file
 NEW DIERR,FILERR
 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^SDES2JSON(.RESULT,.ERRORS)
 Q
 ;
GETCONTACTS(RESULT,SDCONTEXT,REQARRAY) ; RPC: SDES2 GET CONTACT ATTEMPT
 N REQTYPE,REQIEN,ERRORS,APPTREQTYPE,REQIEN,REQTYPE,DFN,CLINIC,PREFDATE,CONTACTS,CONTACTIEN
 D ASSIGNREQVAR(.REQARRAY,.REQTYPE,.REQIEN)
 D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
 I $D(ERRORS) S ERRORS("Contact",1)="" D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
 ;
 D VALFIELD^SDES2VALUTIL(,.ERRORS,409.86,2.1,REQTYPE,,0,395,396)
 D REQUESTINFO(.ERRORS,.REQARRAY,.APPTREQTYPE)
 I $D(ERRORS) S ERRORS("Contact",1)="" D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
 ;
 D GETCONTACTIEN(.CONTACTIEN,APPTREQTYPE)
 I $G(CONTACTIEN)="" S CONTACTS("Contact",1)="",CONTACTS("ContactAttempts")="" D BUILDJSON^SDES2JSON(.RESULT,.CONTACTS) Q
 D BLDRETNINFO(.CONTACTS,CONTACTIEN)
 D DISPCONTACT(.CONTACTS,CONTACTIEN)
 D BUILDJSON^SDESBUILDJSON(.RESULT,.CONTACTS)
 Q
 ;
ASSIGNREQVAR(REQARRAY,REQTYPE,REQIEN) ;
 S REQTYPE=$G(REQARRAY("REQTYPE"))
 S REQIEN=$G(REQARRAY("REQUESTIEN"))
 Q
 ;
DISPCONTACT(RESULT,CONTACTIEN,CLINIC) ;get contact attempt information given contact ien
 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")
 .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")))
 .S CONTACTS("ContactAttempts",CCNT,"DateTimeEntered")=DTTMENTERED
 .K CONTDATA
 I '$D(CONTACTS) S CONTACTS("ContactAttempts",1)=""
 M RESULT=CONTACTS
 Q
 ;
GETSRV(REQTYP,REQIEN) ; Function to get SERVICE based on Request type and ien
 N SERVICE S SERVICE=""
 I 'REQIEN!(REQTYP="") Q SERVICE
 I (REQTYP="A")!(REQTYP="RTC")!(REQTYP="V") D  Q SERVICE
 . S SERVICE=$$GET1^DIQ(409.85,REQIEN,8.5,"I")
 . S SERVICE=SERVICE_"^"_$$GET1^DIQ(409.85,REQIEN,8.5,"E")
 I (REQTYP="C")!(REQTYP="P") D  Q SERVICE
 . S SERVICE=$$GET1^DIQ(123,REQIEN,1,"I")
 . S SERVICE=SERVICE_"^"_$$GET1^DIQ(123,REQIEN,1,"E")
 Q SERVICE
 ;