SDESARCLOSE ;ALB/BLB,KML,MGD,DJS - VISTA SCHEDULING RPCS ;Sep 05, 2022
;;5.3;Scheduling;**794,799,805,809,815,818,819,820,825**;Aug 13, 1993;Build 2
;;Per VHA Directive 6402, this routine should not be modified
; Reference to ^DPT(DFN,0) in ICR #10035
;
DISPOSITION(RETURN,ARIEN,DISP,DISPBY,DISPDT,EASTRCKNGNMBR,PCMT) ;Disposition an appt req
;Input
; IEN - Request ID - Pointer to SDEC APPT REQUEST file
; DISP - Disposition
; DISPBY - User Id - Pointer to NEW PERSON file
; DISPDT - Date Dispositioned in external form (e.g.,CCYY-MM-DD)
; EASTRCKNGNMBR - (optional) Enterprise Appointment Scheduling Tracking Number associated to an appointment.
; PCMT - (optional) patient-entered comments from VAOS
N SDAPTREQ,POP,ARFDA,ARRET,ARMSG,X,MI,%DT
I $G(ARIEN)="" S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,3)
I $G(ARIEN)'="",'$D(^SDEC(409.85,ARIEN)) S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,4)
I $G(DISP)="" S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,42)
; Re-mapped the Dispositions to their corresponding pointer value
I $G(DISP)'="" D
.S:DISP="DEATH" DISP=1
.S:DISP="REMOVED/NON-VA CARE" DISP=2
.S:DISP="REMOVED/SCHEDULED-ASSIGNED" DISP=3
.S:DISP="REMOVED/VA CONTRACT CARE" DISP=4
.S:DISP="REMOVED/NO LONGER NECESSARY" DISP=5
.S:DISP="ENTERED IN ERROR" DISP=6
.S:DISP="TRANSFERRED TO EWL" DISP=7
.S:DISP="CHANGED CLINIC" DISP=8
.S:DISP="MRTC PARENT CLOSED" DISP=9
.S:DISP="REMOVED/EXTERNAL APP" DISP=10 ;* 745
.S:DISP="FAILURE TO RESPOND" DISP=11
.S:DISP="VET SELF-CANCEL" DISP=12
I $G(DISP)'="" D
.I '+DISP!((DISP<1)!(DISP>12)) D
..S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,43)
;validate DISPOSITIONED BY
I $G(DISPBY)="" D
.S DISPBY=$S(+$G(DUZ):DUZ,1:$$FIND1^DIC(200,"","X","SDESOITEAS,SRV","B"))
.I $G(DISPBY)="" S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,269) ;VSE-3761 new error message
I $G(DISPBY)'="",'$D(^VA(200,+DISPBY,0)) S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,268) ;VSE-3761 new error message
;validate DATE DISPOSITIONED
I $G(DISPDT)'="" S DISPDT=$$ISOTFM^SDAMUTDT(DISPDT) D ;VSE-2396
.I DISPDT=-1 S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,55)
I $G(DISPDT)="" S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,56)
;validate EAS Tracking Number
S EASTRCKNGNMBR=$TR($G(EASTRCKNGNMBR),"^"," ")
I $L(EASTRCKNGNMBR) S EASTRCKNGNMBR=$$EASVALIDATE^SDESUTIL(EASTRCKNGNMBR)
I EASTRCKNGNMBR=-1 S POP=1 D ERRLOG^SDESJSON(.SDAPTREQ,142)
; validate Patient-Entered comments
S PCMT=$TR($G(PCMT),"^"," ")
I $G(POP) S SDAPTREQ("ApptReqDisposition",1)=""
;
I '$G(POP) D
.S ARFDA=$NA(ARFDA(409.85,ARIEN_","))
.S @ARFDA@(19)=DISPDT
.S @ARFDA@(20)=DISPBY
.S @ARFDA@(21)=DISP
.S @ARFDA@(23)="C"
.S @ARFDA@(100)=EASTRCKNGNMBR
.D UPDATE^DIE("","ARFDA","ARRET","ARMSG")
.I '$D(ARMSG) D
..S SDAPTREQ("ApptReqDisposition","FilingSuccess")=1
.I $D(ARMSG("DIERR")) D
..S POP=1
..F MI=1:1:$G(ARMSG("DIERR")) D ERRLOG^SDESJSON(.SDAPTREQ,47,$G(ARMSG("DIERR",MI,"TEXT",1)))
.;SEND HL7 TO CPRS IF RTC REQUEST
.I '$G(POP),$P(^SDEC(409.85,ARIEN,0),U,5)="RTC" D
..I DISP=3!(DISP=9) D ARDISP^SDECHL7(ARIEN,"")
..I DISP'=3&(DISP'=9) D ARDISP^SDECHL7(ARIEN,1)
..I $D(^TMP($J,"REJECT",ARIEN)) D
...S POP=1,X=$G(^TMP(SDHL7IN("ORDER IEN")))
...D ERRLOG^SDESJSON(.SDAPTREQ,47,X)
.I '$G(POP) D EDITPCMT(ARIEN,PCMT)
D BUILDER
Q
;
EDITPCMT(ARIEN,COMMENTSFLD60) ; update word processing PATIENT COMMENTS (409.855,60)
; ARIEN - (required) IEN to entry in 409.85
; COMMENTSFLD60 - (optional) VAOS related patient-entered comments
N SDFDA,PCMTSARRAY
S COMMENTSFLD60=$G(COMMENTSFLD60)
D WP^SDECUTL(.PCMTSARRAY,COMMENTSFLD60)
D WP^DIE(409.85,ARIEN_",",60,"","PCMTSARRAY")
Q
;
BUILDER ;Convert data to JSON
N JSONERR
S JSONERR=""
D ENCODE^SDESJSON(.SDAPTREQ,.RETURN,.JSONERR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESARCLOSE 3785 printed Nov 22, 2024@18:05:39 Page 2
SDESARCLOSE ;ALB/BLB,KML,MGD,DJS - VISTA SCHEDULING RPCS ;Sep 05, 2022
+1 ;;5.3;Scheduling;**794,799,805,809,815,818,819,820,825**;Aug 13, 1993;Build 2
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ; Reference to ^DPT(DFN,0) in ICR #10035
+4 ;
DISPOSITION(RETURN,ARIEN,DISP,DISPBY,DISPDT,EASTRCKNGNMBR,PCMT) ;Disposition an appt req
+1 ;Input
+2 ; IEN - Request ID - Pointer to SDEC APPT REQUEST file
+3 ; DISP - Disposition
+4 ; DISPBY - User Id - Pointer to NEW PERSON file
+5 ; DISPDT - Date Dispositioned in external form (e.g.,CCYY-MM-DD)
+6 ; EASTRCKNGNMBR - (optional) Enterprise Appointment Scheduling Tracking Number associated to an appointment.
+7 ; PCMT - (optional) patient-entered comments from VAOS
+8 NEW SDAPTREQ,POP,ARFDA,ARRET,ARMSG,X,MI,%DT
+9 IF $GET(ARIEN)=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,3)
+10 IF $GET(ARIEN)'=""
IF '$DATA(^SDEC(409.85,ARIEN))
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,4)
+11 IF $GET(DISP)=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,42)
+12 ; Re-mapped the Dispositions to their corresponding pointer value
+13 IF $GET(DISP)'=""
Begin DoDot:1
+14 if DISP="DEATH"
SET DISP=1
+15 if DISP="REMOVED/NON-VA CARE"
SET DISP=2
+16 if DISP="REMOVED/SCHEDULED-ASSIGNED"
SET DISP=3
+17 if DISP="REMOVED/VA CONTRACT CARE"
SET DISP=4
+18 if DISP="REMOVED/NO LONGER NECESSARY"
SET DISP=5
+19 if DISP="ENTERED IN ERROR"
SET DISP=6
+20 if DISP="TRANSFERRED TO EWL"
SET DISP=7
+21 if DISP="CHANGED CLINIC"
SET DISP=8
+22 if DISP="MRTC PARENT CLOSED"
SET DISP=9
+23 ;* 745
if DISP="REMOVED/EXTERNAL APP"
SET DISP=10
+24 if DISP="FAILURE TO RESPOND"
SET DISP=11
+25 if DISP="VET SELF-CANCEL"
SET DISP=12
End DoDot:1
+26 IF $GET(DISP)'=""
Begin DoDot:1
+27 IF '+DISP!((DISP<1)!(DISP>12))
Begin DoDot:2
+28 SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,43)
End DoDot:2
End DoDot:1
+29 ;validate DISPOSITIONED BY
+30 IF $GET(DISPBY)=""
Begin DoDot:1
+31 SET DISPBY=$SELECT(+$GET(DUZ):DUZ,1:$$FIND1^DIC(200,"","X","SDESOITEAS,SRV","B"))
+32 ;VSE-3761 new error message
IF $GET(DISPBY)=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,269)
End DoDot:1
+33 ;VSE-3761 new error message
IF $GET(DISPBY)'=""
IF '$DATA(^VA(200,+DISPBY,0))
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,268)
+34 ;validate DATE DISPOSITIONED
+35 ;VSE-2396
IF $GET(DISPDT)'=""
SET DISPDT=$$ISOTFM^SDAMUTDT(DISPDT)
Begin DoDot:1
+36 IF DISPDT=-1
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,55)
End DoDot:1
+37 IF $GET(DISPDT)=""
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,56)
+38 ;validate EAS Tracking Number
+39 SET EASTRCKNGNMBR=$TRANSLATE($GET(EASTRCKNGNMBR),"^"," ")
+40 IF $LENGTH(EASTRCKNGNMBR)
SET EASTRCKNGNMBR=$$EASVALIDATE^SDESUTIL(EASTRCKNGNMBR)
+41 IF EASTRCKNGNMBR=-1
SET POP=1
DO ERRLOG^SDESJSON(.SDAPTREQ,142)
+42 ; validate Patient-Entered comments
+43 SET PCMT=$TRANSLATE($GET(PCMT),"^"," ")
+44 IF $GET(POP)
SET SDAPTREQ("ApptReqDisposition",1)=""
+45 ;
+46 IF '$GET(POP)
Begin DoDot:1
+47 SET ARFDA=$NAME(ARFDA(409.85,ARIEN_","))
+48 SET @ARFDA@(19)=DISPDT
+49 SET @ARFDA@(20)=DISPBY
+50 SET @ARFDA@(21)=DISP
+51 SET @ARFDA@(23)="C"
+52 SET @ARFDA@(100)=EASTRCKNGNMBR
+53 DO UPDATE^DIE("","ARFDA","ARRET","ARMSG")
+54 IF '$DATA(ARMSG)
Begin DoDot:2
+55 SET SDAPTREQ("ApptReqDisposition","FilingSuccess")=1
End DoDot:2
+56 IF $DATA(ARMSG("DIERR"))
Begin DoDot:2
+57 SET POP=1
+58 FOR MI=1:1:$GET(ARMSG("DIERR"))
DO ERRLOG^SDESJSON(.SDAPTREQ,47,$GET(ARMSG("DIERR",MI,"TEXT",1)))
End DoDot:2
+59 ;SEND HL7 TO CPRS IF RTC REQUEST
+60 IF '$GET(POP)
IF $PIECE(^SDEC(409.85,ARIEN,0),U,5)="RTC"
Begin DoDot:2
+61 IF DISP=3!(DISP=9)
DO ARDISP^SDECHL7(ARIEN,"")
+62 IF DISP'=3&(DISP'=9)
DO ARDISP^SDECHL7(ARIEN,1)
+63 IF $DATA(^TMP($JOB,"REJECT",ARIEN))
Begin DoDot:3
+64 SET POP=1
SET X=$GET(^TMP(SDHL7IN("ORDER IEN")))
+65 DO ERRLOG^SDESJSON(.SDAPTREQ,47,X)
End DoDot:3
End DoDot:2
+66 IF '$GET(POP)
DO EDITPCMT(ARIEN,PCMT)
End DoDot:1
+67 DO BUILDER
+68 QUIT
+69 ;
EDITPCMT(ARIEN,COMMENTSFLD60) ; update word processing PATIENT COMMENTS (409.855,60)
+1 ; ARIEN - (required) IEN to entry in 409.85
+2 ; COMMENTSFLD60 - (optional) VAOS related patient-entered comments
+3 NEW SDFDA,PCMTSARRAY
+4 SET COMMENTSFLD60=$GET(COMMENTSFLD60)
+5 DO WP^SDECUTL(.PCMTSARRAY,COMMENTSFLD60)
+6 DO WP^DIE(409.85,ARIEN_",",60,"","PCMTSARRAY")
+7 QUIT
+8 ;
BUILDER ;Convert data to JSON
+1 NEW JSONERR
+2 SET JSONERR=""
+3 DO ENCODE^SDESJSON(.SDAPTREQ,.RETURN,.JSONERR)
+4 QUIT
