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

SDES2GETDISPCONS.m

Go to the documentation of this file. 
  1. SDES2GETDISPCONS ;ALB/JAS - VISTA SCHEDULING - SDES2 GET DISP CONT ATTEMPTS ;Aug 23,2024
  1.  ;;5.3;Scheduling;**885,886,887**;Aug 13, 1993;Build 7
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  Q
  1.  ;
  1. GETCONTACTS(RESULT,SDCONTEXT,REQARRAY) ; RPC: SDES2 GET DISP CONT ATTEMPTS
  1.  N ERRORS,PATDFN,CNATDATE,CHKDATE,CHKMTCH,CONTACTS,CONTACTIEN,CONCNT
  1.  D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
  1.  I $D(ERRORS) S ERRORS("Contact",1)="" D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
  1.  ;
  1.  S PATDFN=$G(REQARRAY("PATIENT DFN"))
  1.  D VALFILEIEN^SDES2VALUTIL(,.ERRORS,2,PATDFN,1,0,1,2)
  1.  I $D(ERRORS) S ERRORS("Contact",1)="" D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
  1.  ;
  1.  S CONTACTIEN="",CONCNT=0
  1.  S CHKDATE=$$FMADD^XLFDT(DT,-365)
  1.  F  S CONTACTIEN=$O(^SDEC(409.86,"B",PATDFN,CONTACTIEN)) Q:'CONTACTIEN  I $D(^SDEC(409.86,CONTACTIEN,1,"B")) D
  1.  . S CNATDATE="",CHKMTCH=0
  1.  . F  S CNATDATE=$O(^SDEC(409.86,CONTACTIEN,1,"B",CNATDATE),-1) Q:CNATDATE=""!(CHKMTCH)  D
  1.  . . Q:+CNATDATE<CHKDATE
  1.  . . S CHKMTCH=1
  1.  . I CHKMTCH D BLDRETNINFO(.CONTACTS,CONTACTIEN,PATDFN,.CONCNT)
  1.  I '$D(CONTACTS) S CONTACTS("Contact",1)="" D BUILDJSON^SDES2JSON(.RESULT,.CONTACTS) Q
  1.  ;
  1.  D BUILDJSON^SDESBUILDJSON(.RESULT,.CONTACTS)
  1.  Q
  1.  ;
  1. BLDRETNINFO(RESULT,IEN,PATDFN,CONCNT) ;build return result of contact attempts
  1.  N FILE,IENS,ERR,PREFDATE,CLINIC,CONTDATA,DISPDATE,REQDAT,REQIEN,REQTYPE,REQTYPECD,SERVICE
  1.  S FILE=409.86,IENS=IEN_","
  1.  D GETS^DIQ(409.86,IENS,"1;2;2.1;2.3","IE","CONTDATA","ERR")
  1.  Q:$D(ERR)
  1.  ;
  1.  S REQIEN=$P($G(CONTDATA(FILE,IENS,2.3,"I")),";"),REQTYPECD=$G(CONTDATA(FILE,IENS,2.1,"I"))
  1.  S CLINIC=$G(CONTDATA(FILE,IENS,1,"I")),PREFDATE=$G(CONTDATA(FILE,IENS,2,"I"))
  1.  ;
  1.  D REQUESTINFO(.REQDAT,REQIEN,REQTYPECD,PATDFN,CLINIC,PREFDATE)
  1.  Q:$G(REQDAT("DISPDATE"))=""
  1.  S:CLINIC="" CLINIC=$G(REQDAT("CLINIC"))
  1.  S SERVICE=$G(REQDAT("SERVICE"))
  1.  S:PREFDATE="" PREFDATE=$G(REQDAT("PREFDATE"))
  1.  S REQTYPE=$S($D(REQDAT("REQTYPE")):REQDAT("REQTYPE"),1:$G(CONTDATA(FILE,IENS,2.1,"E")))
  1.  S PREFDATE=$$FMTISO^SDAMUTDT(PREFDATE,$G(CLINIC))
  1.  I PREFDATE<0 S PREFDATE=""
  1.  ;
  1.  S CONCNT=CONCNT+1
  1.  S RESULT("Contact",CONCNT,"ContactID")=$P(IENS,",")
  1.  S RESULT("Contact",CONCNT,"Patient")=PATDFN
  1.  S RESULT("Contact",CONCNT,"Clinic")=CLINIC
  1.  S RESULT("Contact",CONCNT,"ClinicName")=$G(CONTDATA(FILE,IENS,1,"E"))
  1.  S RESULT("Contact",CONCNT,"Service")=SERVICE
  1.  S RESULT("Contact",CONCNT,"PreferredDate")=PREFDATE
  1.  S RESULT("Contact",CONCNT,"RequestType")=REQTYPE
  1.  S RESULT("Contact",CONCNT,"RequestIEN")=$P($G(CONTDATA(FILE,IENS,2.3,"I")),";")
  1.  S DISPDATE=$$FMTISO^SDAMUTDT($G(REQDAT("DISPDATE")),$G(CLINIC))
  1.  S RESULT("Contact",CONCNT,"DispositionDate")=DISPDATE
  1.  S RESULT("Contact",CONCNT,"DispositionedBy")=$G(REQDAT("DISPBY"))
  1.  S RESULT("Contact",CONCNT,"RecallReqRemovedIEN")=$G(REQDAT("RRRIEN"))
  1.  K CONTDATA
  1.  ;
  1.  D DISPCONTACT(.RESULT,IEN,CONCNT)
  1.  Q
  1.  ;
  1. REQUESTINFO(REQDAT,REQUESTIEN,REQTYPECD,PATDFN,CLINIC,PREFDATE) ;
  1.  ; Given the request ien and request type, return back information needed for return
  1.  I (REQTYPECD="A")!(REQTYPECD="RTC")!(REQTYPECD="V") D  Q
  1.  . I CLINIC="" S REQDAT("CLINIC")=$$GET1^DIQ(409.85,REQUESTIEN,8,"I")
  1.  . S REQDAT("SERVICE")=$$GET1^DIQ(409.85,REQUESTIEN,8.5,"E")
  1.  . I PREFDATE="" S REQDAT("PREFDATE")=$$GET1^DIQ(409.85,REQUESTIEN,22,"I")
  1.  . S REQDAT("REQTYPE")=$$GET1^DIQ(409.85,REQUESTIEN,4,"I")
  1.  . S REQDAT("DISPDATE")=$$GET1^DIQ(409.85,REQUESTIEN,19,"I")
  1.  . S REQDAT("DISPBY")=$$GET1^DIQ(409.85,REQUESTIEN,20,"E")
  1.  ;
  1.  I (REQTYPECD="C")!(REQTYPECD="P") D  Q
  1.  . N LASTACT S LASTACT=$$GET1^DIQ(123,REQUESTIEN,9,"E")
  1.  . Q:(LASTACT'="DISCONTINUED")&(LASTACT'="CANCELLED")
  1.  . S REQDAT("SERVICE")=$$GET1^DIQ(123,REQUESTIEN,1,"E")
  1.  . I 'PREFDATE D
  1.  . . S REQDAT("PREFDATE")=$$GET1^DIQ(123,REQUESTIEN,17,"I")
  1.  . . S:$G(REQDAT("PREFDATE"))="" REQDAT("PREFDATE")=$$GET1^DIQ(123,REQUESTIEN,.01,"I")
  1.  . N ACTDATE,ACTIEN
  1.  . S ACTDATE=$O(^GMR(123,REQUESTIEN,40,"B",""),-1) Q:'ACTDATE  D
  1.  . . S ACTIEN=$O(^GMR(123,REQUESTIEN,40,"B",ACTDATE,""),-1) Q:'ACTIEN  D
  1.  . . . S REQDAT("DISPDATE")=$$GET1^DIQ(123.02,ACTIEN_","_REQUESTIEN_",",2,"I")
  1.  . . . S REQDAT("DISPBY")=$$GET1^DIQ(123.02,ACTIEN_","_REQUESTIEN_",",4,"E")
  1.  ;
  1.  I REQTYPECD="R" D
  1.  . I $D(^SD(403.5,REQUESTIEN)) S REQDAT("DISPDATE")="" Q
  1.  . I $D(^SD(403.56,"B",PATDFN)) D
  1.  . . N RRRIEN S RRRIEN=0
  1.  . . F  S RRRIEN=$O(^SD(403.56,"B",PATDFN,RRRIEN)) Q:'RRRIEN  D
  1.  . . . Q:CLINIC'=$$GET1^DIQ(403.56,RRRIEN,4.5,"I")
  1.  . . . Q:PREFDATE'=$$GET1^DIQ(403.56,RRRIEN,5,"I")
  1.  . . . Q:$$GET1^DIQ(403.56,RRRIEN,203,"E")="APPT SCHEDULED"
  1.  . . . S REQDAT("DISPDATE")=$$GET1^DIQ(403.56,RRRIEN,201,"I")
  1.  . . . S REQDAT("DISPBY")=$$GET1^DIQ(403.56,RRRIEN,202,"E")
  1.  . . . S REQDAT("RRRIEN")=RRRIEN
  1.  . . . S REQDAT("SERVICE")=""
  1.  Q
  1.  ;
  1. DISPCONTACT(RESULT,CONTACTIEN,CONCNT) ;get contact attempt information given contact ien
  1.  N CONTMULT,CIENS,CONTDATA,CCNT,CONTACTS,CONTDATE
  1.  S CONTACTIEN=$G(CONTACTIEN),CCNT=0
  1.  S CONTMULT=0 F  S CONTMULT=$O(^SDEC(409.86,CONTACTIEN,1,CONTMULT)) Q:'CONTMULT  D
  1.  .S CIENS=CONTMULT_","_CONTACTIEN_","
  1.  .D GETS^DIQ(409.863,CIENS,".01;1;2;4;5","IE","CONTDATA")
  1.  .I '$G(CLINIC) S CLINIC=$$GET1^DIQ(409.86,CONTACTIEN,1,"I")
  1.  .S CONTDATE=$G(CONTDATA(409.863,CIENS,.01,"I"))
  1.  .S CONTDATE=$$FMTISO^SDAMUTDT(CONTDATE,$G(CLINIC))
  1.  .;
  1.  .S CCNT=CCNT+1
  1.  .S CONTACTS("Contact",CONCNT,"ContactAttempts",CCNT,"DateTimeOfContact")=CONTDATE
  1.  .S CONTACTS("Contact",CONCNT,"ContactAttempts",CCNT,"ContactType")=$G(CONTDATA(409.863,CIENS,1,"E"))
  1.  .S CONTACTS("Contact",CONCNT,"ContactAttempts",CCNT,"Comments")=$G(CONTDATA(409.863,CIENS,2,"E"))
  1.  .S CONTACTS("Contact",CONCNT,"ContactAttempts",CCNT,"SequenceOfAttempt")=$G(CONTDATA(409.863,CIENS,4,"E"))
  1.  .S CONTACTS("Contact",CONCNT,"ContactAttempts",CCNT,"ContactEnteredBy")=$G(CONTDATA(409.863,CIENS,5,"E"))
  1.  .K CONTDATA
  1.  S CONTACTS("Contact",CONCNT,"TotalAttemptsMade")=$G(CCNT)
  1.  M RESULT=CONTACTS
  1.  Q
  1.  ;