SDES2GETDISPCONS ;ALB/JAS - VISTA SCHEDULING - SDES2 GET DISP CONT ATTEMPTS ;Aug 23,2024
;;5.3;Scheduling;**885,886,887**;Aug 13, 1993;Build 7
;;Per VHA Directive 6402, this routine should not be modified
Q
;
GETCONTACTS(RESULT,SDCONTEXT,REQARRAY) ; RPC: SDES2 GET DISP CONT ATTEMPTS
N ERRORS,PATDFN,CNATDATE,CHKDATE,CHKMTCH,CONTACTS,CONTACTIEN,CONCNT
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("Contact",1)="" D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
;
S PATDFN=$G(REQARRAY("PATIENT DFN"))
D VALFILEIEN^SDES2VALUTIL(,.ERRORS,2,PATDFN,1,0,1,2)
I $D(ERRORS) S ERRORS("Contact",1)="" D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
;
S CONTACTIEN="",CONCNT=0
S CHKDATE=$$FMADD^XLFDT(DT,-365)
F S CONTACTIEN=$O(^SDEC(409.86,"B",PATDFN,CONTACTIEN)) Q:'CONTACTIEN I $D(^SDEC(409.86,CONTACTIEN,1,"B")) D
. S CNATDATE="",CHKMTCH=0
. F S CNATDATE=$O(^SDEC(409.86,CONTACTIEN,1,"B",CNATDATE),-1) Q:CNATDATE=""!(CHKMTCH) D
. . Q:+CNATDATE<CHKDATE
. . S CHKMTCH=1
. I CHKMTCH D BLDRETNINFO(.CONTACTS,CONTACTIEN,PATDFN,.CONCNT)
I '$D(CONTACTS) S CONTACTS("Contact",1)="" D BUILDJSON^SDES2JSON(.RESULT,.CONTACTS) Q
;
D BUILDJSON^SDESBUILDJSON(.RESULT,.CONTACTS)
Q
;
BLDRETNINFO(RESULT,IEN,PATDFN,CONCNT) ;build return result of contact attempts
N FILE,IENS,ERR,PREFDATE,CLINIC,CONTDATA,DISPDATE,REQDAT,REQIEN,REQTYPE,REQTYPECD,SERVICE
S FILE=409.86,IENS=IEN_","
D GETS^DIQ(409.86,IENS,"1;2;2.1;2.3","IE","CONTDATA","ERR")
Q:$D(ERR)
;
S REQIEN=$P($G(CONTDATA(FILE,IENS,2.3,"I")),";"),REQTYPECD=$G(CONTDATA(FILE,IENS,2.1,"I"))
S CLINIC=$G(CONTDATA(FILE,IENS,1,"I")),PREFDATE=$G(CONTDATA(FILE,IENS,2,"I"))
;
D REQUESTINFO(.REQDAT,REQIEN,REQTYPECD,PATDFN,CLINIC,PREFDATE)
Q:$G(REQDAT("DISPDATE"))=""
S:CLINIC="" CLINIC=$G(REQDAT("CLINIC"))
S SERVICE=$G(REQDAT("SERVICE"))
S:PREFDATE="" PREFDATE=$G(REQDAT("PREFDATE"))
S REQTYPE=$S($D(REQDAT("REQTYPE")):REQDAT("REQTYPE"),1:$G(CONTDATA(FILE,IENS,2.1,"E")))
S PREFDATE=$$FMTISO^SDAMUTDT(PREFDATE,$G(CLINIC))
I PREFDATE<0 S PREFDATE=""
;
S CONCNT=CONCNT+1
S RESULT("Contact",CONCNT,"ContactID")=$P(IENS,",")
S RESULT("Contact",CONCNT,"Patient")=PATDFN
S RESULT("Contact",CONCNT,"Clinic")=CLINIC
S RESULT("Contact",CONCNT,"ClinicName")=$G(CONTDATA(FILE,IENS,1,"E"))
S RESULT("Contact",CONCNT,"Service")=SERVICE
S RESULT("Contact",CONCNT,"PreferredDate")=PREFDATE
S RESULT("Contact",CONCNT,"RequestType")=REQTYPE
S RESULT("Contact",CONCNT,"RequestIEN")=$P($G(CONTDATA(FILE,IENS,2.3,"I")),";")
S DISPDATE=$$FMTISO^SDAMUTDT($G(REQDAT("DISPDATE")),$G(CLINIC))
S RESULT("Contact",CONCNT,"DispositionDate")=DISPDATE
S RESULT("Contact",CONCNT,"DispositionedBy")=$G(REQDAT("DISPBY"))
S RESULT("Contact",CONCNT,"RecallReqRemovedIEN")=$G(REQDAT("RRRIEN"))
K CONTDATA
;
D DISPCONTACT(.RESULT,IEN,CONCNT)
Q
;
REQUESTINFO(REQDAT,REQUESTIEN,REQTYPECD,PATDFN,CLINIC,PREFDATE) ;
; Given the request ien and request type, return back information needed for return
I (REQTYPECD="A")!(REQTYPECD="RTC")!(REQTYPECD="V") D Q
. I CLINIC="" S REQDAT("CLINIC")=$$GET1^DIQ(409.85,REQUESTIEN,8,"I")
. S REQDAT("SERVICE")=$$GET1^DIQ(409.85,REQUESTIEN,8.5,"E")
. I PREFDATE="" S REQDAT("PREFDATE")=$$GET1^DIQ(409.85,REQUESTIEN,22,"I")
. S REQDAT("REQTYPE")=$$GET1^DIQ(409.85,REQUESTIEN,4,"I")
. S REQDAT("DISPDATE")=$$GET1^DIQ(409.85,REQUESTIEN,19,"I")
. S REQDAT("DISPBY")=$$GET1^DIQ(409.85,REQUESTIEN,20,"E")
;
I (REQTYPECD="C")!(REQTYPECD="P") D Q
. N LASTACT S LASTACT=$$GET1^DIQ(123,REQUESTIEN,9,"E")
. Q:(LASTACT'="DISCONTINUED")&(LASTACT'="CANCELLED")
. S REQDAT("SERVICE")=$$GET1^DIQ(123,REQUESTIEN,1,"E")
. I 'PREFDATE D
. . S REQDAT("PREFDATE")=$$GET1^DIQ(123,REQUESTIEN,17,"I")
. . S:$G(REQDAT("PREFDATE"))="" REQDAT("PREFDATE")=$$GET1^DIQ(123,REQUESTIEN,.01,"I")
. N ACTDATE,ACTIEN
. S ACTDATE=$O(^GMR(123,REQUESTIEN,40,"B",""),-1) Q:'ACTDATE D
. . S ACTIEN=$O(^GMR(123,REQUESTIEN,40,"B",ACTDATE,""),-1) Q:'ACTIEN D
. . . S REQDAT("DISPDATE")=$$GET1^DIQ(123.02,ACTIEN_","_REQUESTIEN_",",2,"I")
. . . S REQDAT("DISPBY")=$$GET1^DIQ(123.02,ACTIEN_","_REQUESTIEN_",",4,"E")
;
I REQTYPECD="R" D
. I $D(^SD(403.5,REQUESTIEN)) S REQDAT("DISPDATE")="" Q
. I $D(^SD(403.56,"B",PATDFN)) D
. . N RRRIEN S RRRIEN=0
. . F S RRRIEN=$O(^SD(403.56,"B",PATDFN,RRRIEN)) Q:'RRRIEN D
. . . Q:CLINIC'=$$GET1^DIQ(403.56,RRRIEN,4.5,"I")
. . . Q:PREFDATE'=$$GET1^DIQ(403.56,RRRIEN,5,"I")
. . . Q:$$GET1^DIQ(403.56,RRRIEN,203,"E")="APPT SCHEDULED"
. . . S REQDAT("DISPDATE")=$$GET1^DIQ(403.56,RRRIEN,201,"I")
. . . S REQDAT("DISPBY")=$$GET1^DIQ(403.56,RRRIEN,202,"E")
. . . S REQDAT("RRRIEN")=RRRIEN
. . . S REQDAT("SERVICE")=""
Q
;
DISPCONTACT(RESULT,CONTACTIEN,CONCNT) ;get contact attempt information given contact ien
N CONTMULT,CIENS,CONTDATA,CCNT,CONTACTS,CONTDATE
S CONTACTIEN=$G(CONTACTIEN),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,".01;1;2;4;5","IE","CONTDATA")
.I '$G(CLINIC) S CLINIC=$$GET1^DIQ(409.86,CONTACTIEN,1,"I")
.S CONTDATE=$G(CONTDATA(409.863,CIENS,.01,"I"))
.S CONTDATE=$$FMTISO^SDAMUTDT(CONTDATE,$G(CLINIC))
.;
.S CCNT=CCNT+1
.S CONTACTS("Contact",CONCNT,"ContactAttempts",CCNT,"DateTimeOfContact")=CONTDATE
.S CONTACTS("Contact",CONCNT,"ContactAttempts",CCNT,"ContactType")=$G(CONTDATA(409.863,CIENS,1,"E"))
.S CONTACTS("Contact",CONCNT,"ContactAttempts",CCNT,"Comments")=$G(CONTDATA(409.863,CIENS,2,"E"))
.S CONTACTS("Contact",CONCNT,"ContactAttempts",CCNT,"SequenceOfAttempt")=$G(CONTDATA(409.863,CIENS,4,"E"))
.S CONTACTS("Contact",CONCNT,"ContactAttempts",CCNT,"ContactEnteredBy")=$G(CONTDATA(409.863,CIENS,5,"E"))
.K CONTDATA
S CONTACTS("Contact",CONCNT,"TotalAttemptsMade")=$G(CCNT)
M RESULT=CONTACTS
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2GETDISPCONS 5899 printed Dec 13, 2024@02:53:59 Page 2
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
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 QUIT
+4 ;
GETCONTACTS(RESULT,SDCONTEXT,REQARRAY) ; RPC: SDES2 GET DISP CONT ATTEMPTS
+1 NEW ERRORS,PATDFN,CNATDATE,CHKDATE,CHKMTCH,CONTACTS,CONTACTIEN,CONCNT
+2 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+3 IF $DATA(ERRORS)
SET ERRORS("Contact",1)=""
DO BUILDJSON^SDES2JSON(.RESULT,.ERRORS)
QUIT
+4 ;
+5 SET PATDFN=$GET(REQARRAY("PATIENT DFN"))
+6 DO VALFILEIEN^SDES2VALUTIL(,.ERRORS,2,PATDFN,1,0,1,2)
+7 IF $DATA(ERRORS)
SET ERRORS("Contact",1)=""
DO BUILDJSON^SDES2JSON(.RESULT,.ERRORS)
QUIT
+8 ;
+9 SET CONTACTIEN=""
SET CONCNT=0
+10 SET CHKDATE=$$FMADD^XLFDT(DT,-365)
+11 FOR
SET CONTACTIEN=$ORDER(^SDEC(409.86,"B",PATDFN,CONTACTIEN))
if 'CONTACTIEN
QUIT
IF $DATA(^SDEC(409.86,CONTACTIEN,1,"B"))
Begin DoDot:1
+12 SET CNATDATE=""
SET CHKMTCH=0
+13 FOR
SET CNATDATE=$ORDER(^SDEC(409.86,CONTACTIEN,1,"B",CNATDATE),-1)
if CNATDATE=""!(CHKMTCH)
QUIT
Begin DoDot:2
+14 if +CNATDATE<CHKDATE
QUIT
+15 SET CHKMTCH=1
End DoDot:2
+16 IF CHKMTCH
DO BLDRETNINFO(.CONTACTS,CONTACTIEN,PATDFN,.CONCNT)
End DoDot:1
+17 IF '$DATA(CONTACTS)
SET CONTACTS("Contact",1)=""
DO BUILDJSON^SDES2JSON(.RESULT,.CONTACTS)
QUIT
+18 ;
+19 DO BUILDJSON^SDESBUILDJSON(.RESULT,.CONTACTS)
+20 QUIT
+21 ;
BLDRETNINFO(RESULT,IEN,PATDFN,CONCNT) ;build return result of contact attempts
+1 NEW FILE,IENS,ERR,PREFDATE,CLINIC,CONTDATA,DISPDATE,REQDAT,REQIEN,REQTYPE,REQTYPECD,SERVICE
+2 SET FILE=409.86
SET IENS=IEN_","
+3 DO GETS^DIQ(409.86,IENS,"1;2;2.1;2.3","IE","CONTDATA","ERR")
+4 if $DATA(ERR)
QUIT
+5 ;
+6 SET REQIEN=$PIECE($GET(CONTDATA(FILE,IENS,2.3,"I")),";")
SET REQTYPECD=$GET(CONTDATA(FILE,IENS,2.1,"I"))
+7 SET CLINIC=$GET(CONTDATA(FILE,IENS,1,"I"))
SET PREFDATE=$GET(CONTDATA(FILE,IENS,2,"I"))
+8 ;
+9 DO REQUESTINFO(.REQDAT,REQIEN,REQTYPECD,PATDFN,CLINIC,PREFDATE)
+10 if $GET(REQDAT("DISPDATE"))=""
QUIT
+11 if CLINIC=""
SET CLINIC=$GET(REQDAT("CLINIC"))
+12 SET SERVICE=$GET(REQDAT("SERVICE"))
+13 if PREFDATE=""
SET PREFDATE=$GET(REQDAT("PREFDATE"))
+14 SET REQTYPE=$SELECT($DATA(REQDAT("REQTYPE")):REQDAT("REQTYPE"),1:$GET(CONTDATA(FILE,IENS,2.1,"E")))
+15 SET PREFDATE=$$FMTISO^SDAMUTDT(PREFDATE,$GET(CLINIC))
+16 IF PREFDATE<0
SET PREFDATE=""
+17 ;
+18 SET CONCNT=CONCNT+1
+19 SET RESULT("Contact",CONCNT,"ContactID")=$PIECE(IENS,",")
+20 SET RESULT("Contact",CONCNT,"Patient")=PATDFN
+21 SET RESULT("Contact",CONCNT,"Clinic")=CLINIC
+22 SET RESULT("Contact",CONCNT,"ClinicName")=$GET(CONTDATA(FILE,IENS,1,"E"))
+23 SET RESULT("Contact",CONCNT,"Service")=SERVICE
+24 SET RESULT("Contact",CONCNT,"PreferredDate")=PREFDATE
+25 SET RESULT("Contact",CONCNT,"RequestType")=REQTYPE
+26 SET RESULT("Contact",CONCNT,"RequestIEN")=$PIECE($GET(CONTDATA(FILE,IENS,2.3,"I")),";")
+27 SET DISPDATE=$$FMTISO^SDAMUTDT($GET(REQDAT("DISPDATE")),$GET(CLINIC))
+28 SET RESULT("Contact",CONCNT,"DispositionDate")=DISPDATE
+29 SET RESULT("Contact",CONCNT,"DispositionedBy")=$GET(REQDAT("DISPBY"))
+30 SET RESULT("Contact",CONCNT,"RecallReqRemovedIEN")=$GET(REQDAT("RRRIEN"))
+31 KILL CONTDATA
+32 ;
+33 DO DISPCONTACT(.RESULT,IEN,CONCNT)
+34 QUIT
+35 ;
REQUESTINFO(REQDAT,REQUESTIEN,REQTYPECD,PATDFN,CLINIC,PREFDATE) ;
+1 ; Given the request ien and request type, return back information needed for return
+2 IF (REQTYPECD="A")!(REQTYPECD="RTC")!(REQTYPECD="V")
Begin DoDot:1
+3 IF CLINIC=""
SET REQDAT("CLINIC")=$$GET1^DIQ(409.85,REQUESTIEN,8,"I")
+4 SET REQDAT("SERVICE")=$$GET1^DIQ(409.85,REQUESTIEN,8.5,"E")
+5 IF PREFDATE=""
SET REQDAT("PREFDATE")=$$GET1^DIQ(409.85,REQUESTIEN,22,"I")
+6 SET REQDAT("REQTYPE")=$$GET1^DIQ(409.85,REQUESTIEN,4,"I")
+7 SET REQDAT("DISPDATE")=$$GET1^DIQ(409.85,REQUESTIEN,19,"I")
+8 SET REQDAT("DISPBY")=$$GET1^DIQ(409.85,REQUESTIEN,20,"E")
End DoDot:1
QUIT
+9 ;
+10 IF (REQTYPECD="C")!(REQTYPECD="P")
Begin DoDot:1
+11 NEW LASTACT
SET LASTACT=$$GET1^DIQ(123,REQUESTIEN,9,"E")
+12 if (LASTACT'="DISCONTINUED")&(LASTACT'="CANCELLED")
QUIT
+13 SET REQDAT("SERVICE")=$$GET1^DIQ(123,REQUESTIEN,1,"E")
+14 IF 'PREFDATE
Begin DoDot:2
+15 SET REQDAT("PREFDATE")=$$GET1^DIQ(123,REQUESTIEN,17,"I")
+16 if $GET(REQDAT("PREFDATE"))=""
SET REQDAT("PREFDATE")=$$GET1^DIQ(123,REQUESTIEN,.01,"I")
End DoDot:2
+17 NEW ACTDATE,ACTIEN
+18 SET ACTDATE=$ORDER(^GMR(123,REQUESTIEN,40,"B",""),-1)
if 'ACTDATE
QUIT
Begin DoDot:2
+19 SET ACTIEN=$ORDER(^GMR(123,REQUESTIEN,40,"B",ACTDATE,""),-1)
if 'ACTIEN
QUIT
Begin DoDot:3
+20 SET REQDAT("DISPDATE")=$$GET1^DIQ(123.02,ACTIEN_","_REQUESTIEN_",",2,"I")
+21 SET REQDAT("DISPBY")=$$GET1^DIQ(123.02,ACTIEN_","_REQUESTIEN_",",4,"E")
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+22 ;
+23 IF REQTYPECD="R"
Begin DoDot:1
+24 IF $DATA(^SD(403.5,REQUESTIEN))
SET REQDAT("DISPDATE")=""
QUIT
+25 IF $DATA(^SD(403.56,"B",PATDFN))
Begin DoDot:2
+26 NEW RRRIEN
SET RRRIEN=0
+27 FOR
SET RRRIEN=$ORDER(^SD(403.56,"B",PATDFN,RRRIEN))
if 'RRRIEN
QUIT
Begin DoDot:3
+28 if CLINIC'=$$GET1^DIQ(403.56,RRRIEN,4.5,"I")
QUIT
+29 if PREFDATE'=$$GET1^DIQ(403.56,RRRIEN,5,"I")
QUIT
+30 if $$GET1^DIQ(403.56,RRRIEN,203,"E")="APPT SCHEDULED"
QUIT
+31 SET REQDAT("DISPDATE")=$$GET1^DIQ(403.56,RRRIEN,201,"I")
+32 SET REQDAT("DISPBY")=$$GET1^DIQ(403.56,RRRIEN,202,"E")
+33 SET REQDAT("RRRIEN")=RRRIEN
+34 SET REQDAT("SERVICE")=""
End DoDot:3
End DoDot:2
End DoDot:1
+35 QUIT
+36 ;
DISPCONTACT(RESULT,CONTACTIEN,CONCNT) ;get contact attempt information given contact ien
+1 NEW CONTMULT,CIENS,CONTDATA,CCNT,CONTACTS,CONTDATE
+2 SET CONTACTIEN=$GET(CONTACTIEN)
SET CCNT=0
+3 SET CONTMULT=0
FOR
SET CONTMULT=$ORDER(^SDEC(409.86,CONTACTIEN,1,CONTMULT))
if 'CONTMULT
QUIT
Begin DoDot:1
+4 SET CIENS=CONTMULT_","_CONTACTIEN_","
+5 DO GETS^DIQ(409.863,CIENS,".01;1;2;4;5","IE","CONTDATA")
+6 IF '$GET(CLINIC)
SET CLINIC=$$GET1^DIQ(409.86,CONTACTIEN,1,"I")
+7 SET CONTDATE=$GET(CONTDATA(409.863,CIENS,.01,"I"))
+8 SET CONTDATE=$$FMTISO^SDAMUTDT(CONTDATE,$GET(CLINIC))
+9 ;
+10 SET CCNT=CCNT+1
+11 SET CONTACTS("Contact",CONCNT,"ContactAttempts",CCNT,"DateTimeOfContact")=CONTDATE
+12 SET CONTACTS("Contact",CONCNT,"ContactAttempts",CCNT,"ContactType")=$GET(CONTDATA(409.863,CIENS,1,"E"))
+13 SET CONTACTS("Contact",CONCNT,"ContactAttempts",CCNT,"Comments")=$GET(CONTDATA(409.863,CIENS,2,"E"))
+14 SET CONTACTS("Contact",CONCNT,"ContactAttempts",CCNT,"SequenceOfAttempt")=$GET(CONTDATA(409.863,CIENS,4,"E"))
+15 SET CONTACTS("Contact",CONCNT,"ContactAttempts",CCNT,"ContactEnteredBy")=$GET(CONTDATA(409.863,CIENS,5,"E"))
+16 KILL CONTDATA
End DoDot:1
+17 SET CONTACTS("Contact",CONCNT,"TotalAttemptsMade")=$GET(CCNT)
+18 MERGE RESULT=CONTACTS
+19 QUIT
+20 ;
