SDESCOMPPEN ;ALB/BWF - VISTA SCHEDULING COMPENSATION AND PENSION RPCS ; Jan 23, 2023
;;5.3;Scheduling;**836,837,839**;Aug 13, 1993;Build 3
;;Per VHA Directive 6402, this routine should not be modified
; Reference to DVBCUTL5 in ICR #7042
; Reference to DVBCCNNS in ICR #7038
; Reference to 2507 REQUEST in ICR #7044
; Reference to AMIE C&P EXAM TRACKING in ICR #7045
;
Q
;
GET(RESULT,DFN,SDCL,SDT) ;GET entries from 2507 REQUEST file 396.3
;INPUT:
; DFN - (required) Patient ID pointer to PATIENT file 2
; SDCL - (required) Clinic ID pointer to HOSPITAL LOCATION file 44
; SDT - (required) Appointment Date/Time in external format
;
N SDDA,ERRORS,RETURN
S DFN=$G(DFN),SDCL=$G(SDCL),SDT=$G(SDT)
;validate DFN
D VALIDATEDFN^SDESINPUTVALUTL(.ERRORS,DFN)
;validate SDCL
D VALIDATECLINIC(.ERRORS,SDCL)
I $D(ERRORS) D Q
.S ERRORS("CompensationPensionRequest",1)=""
.D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
;validate SDT
S SDT=$$VALDATE2^SDESVALUTIL(.ERRORS,SDT,SDCL,76,77)
I $D(ERRORS) D Q
.S ERRORS("CompensationPensionRequest",1)=""
.D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
S SDDA=0 F S SDDA=$O(^SC(SDCL,"S",SDT,1,SDDA)) Q:SDDA'>0 Q:$P($G(^SC(SDCL,"S",SDT,1,SDDA,0)),U,1)=DFN
I 'SDDA D ERRLOG^SDESJSON(.ERRORS,418)
I $D(ERRORS) D Q
.S ERRORS("CompensationPensionRequest",1)=""
.D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
D GETREQUESTS(.RETURN,DFN,SDCL)
I '$D(RETURN) S RETURN("CompensationPensionRequest",1)=""
D BUILDJSON^SDESBUILDJSON(.RESULT,.RETURN)
Q
;
;from DVBCMKLK
GETREQUESTS(RETURN,DFN,CLINIEN) ;
N DVBADFN,DVBASDPR,DVBASTAT,CNT,DVBADA,SDINVERSE,SDREQDATE,REQIEN,SDLOOP,SDAMIEIEN,INITIALAPPTDT,ORIGAPPTDT,CURRAPPTDT,CLINNAME,LINKCNT,TMP
S DVBADFN=DFN,DVBASTAT="P" ;**DVBASTAT used in REQARY^DVBCUTL5
; DVBADA/DVBASDPR initialized before calling REQARY^DVBCUTL5 since the function does not initialize
S (DVBADA,DVBASDPR)=""
K ^TMP("DVBC",$J),TMP("DVBC LINK")
D REQARY^DVBCUTL5 ;**Set up ^TMP of AMIE 2507's
;^TMP("DVBC",8945,6889775.889799,3110224.1102,34231)=""
; Inverse REQUEST DATE, REQUEST DATE, IEN)
S CNT=0
S SDINVERSE="" F S SDINVERSE=$O(^TMP("DVBC",$J,SDINVERSE)) Q:SDINVERSE="" D
.S SDREQDATE="" F S SDREQDATE=$O(^TMP("DVBC",$J,SDINVERSE,SDREQDATE)) Q:SDREQDATE="" D
..S REQIEN="" F S REQIEN=$O(^TMP("DVBC",$J,SDINVERSE,SDREQDATE,REQIEN)) Q:REQIEN="" D
...S CNT=CNT+1
...S RETURN("CompensationPensionRequest",CNT,"RequestID")=REQIEN ; 2507 REQUEST ID
...S RETURN("CompensationPensionRequest",CNT,"PatientID")=DFN
...S RETURN("CompensationPensionRequest",CNT,"PatientName")=$$GET1^DIQ(2,DFN_",",.01)
...S RETURN("CompensationPensionRequest",CNT,"RequestDate")=$$FMTISO^SDAMUTDT(SDREQDATE,CLINIEN)
...S RETURN("CompensationPensionRequest",CNT,"IsTrackedAmie")=+$E($D(^DVB(396.95,"AR",REQIEN)),1)
...K TMP("DVBC LINK")
...S LINKCNT=0
...D LNKARY^DVBCUTA3(REQIEN,DFN)
...S SDLOOP="" F S SDLOOP=$O(TMP("DVBC LINK",SDLOOP)) Q:SDLOOP="" D
....S SDAMIEIEN="" F S SDAMIEIEN=$O(TMP("DVBC LINK",SDLOOP,SDAMIEIEN)) Q:SDAMIEIEN="" D
.....S INITIALAPPTDT=$$CONVDATE($P(TMP("DVBC LINK",SDLOOP,SDAMIEIEN),U))
.....S ORIGAPPTDT=$$CONVDATE($P(TMP("DVBC LINK",SDLOOP,SDAMIEIEN),U,2))
.....S CURRAPPTDT=$$CONVDATE($P(TMP("DVBC LINK",SDLOOP,SDAMIEIEN),U,3))
.....S CLINNAME=$P(TMP("DVBC LINK",SDLOOP,SDAMIEIEN),U,4)
.....S LINKCNT=LINKCNT+1
.....S RETURN("CompensationPensionRequest",CNT,"Links",LINKCNT,"AMIETrackingID")=SDAMIEIEN
.....S RETURN("CompensationPensionRequest",CNT,"Links",LINKCNT,"InitialAppointmentDate")=$$FMTISO^SDAMUTDT(INITIALAPPTDT,CLINIEN)
.....S RETURN("CompensationPensionRequest",CNT,"Links",LINKCNT,"OriginalAppointmentDate")=$$FMTISO^SDAMUTDT(ORIGAPPTDT,CLINIEN)
.....S RETURN("CompensationPensionRequest",CNT,"Links",LINKCNT,"CurrentAppointmentDate")=$$FMTISO^SDAMUTDT(CURRAPPTDT,CLINIEN)
.....S RETURN("CompensationPensionRequest",CNT,"Links",LINKCNT,"ClinicName")=CLINNAME
.....S RETURN("CompensationPensionRequest",CNT,"Links",LINKCNT,"ClinicID")=$$FIND1^DIC(44,,"B",CLINNAME)
K ^TMP("DVBC",$J)
K TMP("DVBC LINK")
Q
; convert external date/time to fileman
CONVDATE(INDATE) ;
N X,Y,%DT
I INDATE="" Q ""
S %DT="ST"
S X=INDATE D ^%DT
I Y<1 Q ""
Q Y
;
SET(RESULT,REQIEN,AMIETRKIEN,VETREQ,SDCL,SDT) ;SET entries to AMIE C&P EXAM TRACKING file 396.95 and update file 396.3
;INPUT:
; 1. REQIEN - (required) 2507 REQUEST id pointer to 2507 REQUEST file 396.3
; 2. AMIETRKIEN - (optional) Link ID - Pointer to AMIE C&P EXAM TRACKING file 396.95
; - This should ONLY be passed in if there is an AMIE tracking ID that is being updated.
; 3. VETREQ - (optional) Veteran Request flag - (field .04 in file 396.95)
; "Is this appointment due to a veteran requested cancellation or 'No Show'"
; 0=NO; 1=YES
; 4. SDCL - (required) pointer to HOSPITAL LOCATION file 44
; 5. SDT - (required) Appointment date/time in external format.
; The appointment date/time will be used as the original date if this is a new appointment
; The appointment date/time will be used as the 'reschedule' date if this is a re-schedule/update (AMIETRKIEN is passed in)
;
N DFN,DVBALKRC,DVBAVTRQ,COMPPEN,SDDA,ERRORS
S REQIEN=$G(REQIEN),SDT=$G(SDT),SDCL=$G(SDCL),AMIETRKIEN=$G(AMIETRKIEN),VETREQ=$G(VETREQ)
;validate REQIEN
D VALREQIEN(.ERRORS,REQIEN)
;validate VETREQ
D VALVETREQ(.ERRORS,VETREQ)
;validate SDCL
D VALIDATECLINIC(.ERRORS,SDCL)
I $D(ERRORS) D Q
.S ERRORS("CompensationPensionSet",1)=""
.D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
;validate SDT
S SDT=$$VALDATE2^SDESVALUTIL(.ERRORS,SDT,SDCL,76,77)
I $D(ERRORS) D Q
.S ERRORS("CompensationPensionSet",1)=""
.D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
S DFN=$$GET1^DIQ(396.3,REQIEN_",",.01,"I")
S SDDA=$$FIND^SDESCHECKOUT(DFN,SDT,SDCL)
I 'SDDA D ERRLOG^SDESJSON(.ERRORS,418)
I $G(AMIETRKIEN)'="" D VALAMIEIEN(.ERRORS,AMIETRKIEN)
I $D(ERRORS) D Q
.S ERRORS("CompensationPensionSet",1)=""
.D BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
I AMIETRKIEN="" D Q
.D CRTREC(SDT,REQIEN,.AMIETRKIEN)
.S COMPPEN("CompensationPensionSet","AMIETrackingRecordAdded")=AMIETRKIEN
.D BUILDJSON^SDESBUILDJSON(.RESULT,.COMPPEN)
I AMIETRKIEN'="" D Q
.D UPDTLK(AMIETRKIEN,SDT,VETREQ)
.S COMPPEN("CompensationPensionSet","AMIETrackingRecordUpdated")=AMIETRKIEN
.D BUILDJSON^SDESBUILDJSON(.RESULT,.COMPPEN)
I '$D(COMPPEN) S COMPPEN("CompensationPensionSet",1)=""
D BUILDJSON^SDESBUILDJSON(.RESULT,.COMPPEN)
Q
CRTREC(SDT,REQIEN,AMIETRKIEN) ;** Add a record to file 396.95 (Appt Tracking)
N FDA,NEWAMIEIEN,AMIEERR
S FDA(396.95,"+1,",.01)=SDT
S FDA(396.95,"+1,",.02)=SDT
S FDA(396.95,"+1,",.03)=SDT
S FDA(396.95,"+1,",.04)=0
S FDA(396.95,"+1,",.06)=REQIEN
S FDA(396.95,"+1,",.07)=1
D UPDATE^DIE(,"FDA","NEWAMIEIEN","AMIEERR")
S AMIETRKIEN=$G(NEWAMIEIEN(1))
Q
UPDTLK(AMIETRKIEN,RSCHDT,VETREQ) ;** Update selected 396.95 link
N FDA
S FDA(396.95,AMIETRKIEN_",",.03)=RSCHDT
S FDA(396.95,AMIETRKIEN_",",.07)=1
I $$GET1^DIQ(396.95,AMIETRKIEN,.04,"I")=0&('$G(VETREQ)) D
.S FDA(396.95,AMIETRKIEN_",",.02)=RSCHDT
I $G(VETREQ) D
.S FDA(396.95,AMIETRKIEN_",",.04)=1
.S FDA(396.95,AMIETRKIEN_",",.05)=RSCHDT
D FILE^DIE(,"FDA") K FDA
Q
AMIECAN(RETURN,DFN,APPTDTTM) ; update amie tracking for cancellations
N AMIEIEN,DVBAAUTO,DVBAFND,DVBALKDA,REQIEN,DVBASTAT,DVBAUPDT,LNKCNT,APPTDTTME,MSGCNT
; DVBASTAT and DVBALKDA used by CANCEL^DVBCCNNS
S DVBASTAT=$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",3,"I")
S (AMIEIEN,DVBALKDA)=""
S (DVBAUPDT,LNKCNT,DVBAFND,MSGCNT,DVBAAUTO)=0
F S AMIEIEN=$O(^DVB(396.95,"CD",APPTDTTM,AMIEIEN)) Q:AMIEIEN="" D
.S REQIEN=$$GET1^DIQ(396.95,AMIEIEN,.06,"I")
.I $$GET1^DIQ(396.3,REQIEN,.01,"I")'=DFN Q
.S LNKCNT=LNKCNT+1
.I $$GET1^DIQ(396.95,AMIEIEN,.07,"I")=1 S DVBAFND=1,DVBALKDA=AMIEIEN
.I 'DVBAFND,$$GET1^DIQ(396.95,AMIEIEN,.08,"I")>DVBAUPDT D
..S DVBAUPDT=$P(^DVB(396.95,AMIEIEN,0),U,8) ;**Keep latest cancel dte
..S DVBALKDA=AMIEIEN ;**Keep DA of rec last cancelled
I (DVBASTAT="PCA")!((DVBASTAT="NA")!(DVBASTAT="CA")) S DVBAAUTO=1
;** Appt not linked
I LNKCNT=0 D
.S APPTDTTME=$$FMTE^XLFDT(APPTDTTM)
.S MSGCNT=MSGCNT+1
.S RETURN("CompensationPensionCancel",MSGCNT,"Text")="Appointment "_APPTDTTME_" was not linked to a 2507 request or was manually rebooked and linked to another appointment."
.S MSGCNT=MSGCNT+1
.S RETURN("CompensationPensionCancel",MSGCNT,"Text")="If the appointment was manually rebooked, you do not want to auto-rebook."
.S MSGCNT=MSGCNT+1
.S RETURN("CompensationPensionCancel",MSGCNT,"Text")="If the appointment was not properly linked, it will need to be linked with the AMIE/C&P appointment link management option."
I 'DVBAAUTO,(DVBAFND) D ;**Appt linked, not Auto
.D CANCEL^DVBCCNNS
.S RETURN("CompensationPensionCancel","Status")="The AMIE C&P Tracking link has been updated."
.S RETURN("CompensationPensionCancel","AmieID")=DVBALKDA
I +LNKCNT>1 D
.S MSGCNT=MSGCNT+1
.S RETURN("CompensationPensionCancel",MSGCNT,"Text")="This C&P appointment has multiple links with the same Current Appt Date. Use the AMIE/C&P Appointment Link Management option to review and delete any duplicate links."
Q
; validate clinic
VALIDATECLINIC(ERRORS,CLINICIEN) ;
I CLINICIEN="" D ERRLOG^SDESJSON(.ERRORS,18) Q
I '$D(^SC(CLINICIEN,0)) D ERRLOG^SDESJSON(.ERRORS,19) Q
Q
; validate request ien
VALREQIEN(ERRORS,REQIEN) ;
I REQIEN="" D ERRLOG^SDESJSON(.ERRORS,419) Q
I '$D(^DVB(396.3,REQIEN)) D ERRLOG^SDESJSON(.ERRORS,420)
Q
VALVETREQ(ERRORS,VETREQ) ;
I VETREQ'=1,VETREQ'="",VETREQ'=0 D ERRLOG^SDESJSON(.ERRORS,422)
Q
VALAMIEIEN(ERRORS,AMIEIEN) ;
I 'AMIETRKIEN!('$D(^DVB(396.95,AMIEIEN))) D ERRLOG^SDESJSON(.ERRORS,421)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESCOMPPEN 9915 printed Oct 16, 2024@18:56:43 Page 2
SDESCOMPPEN ;ALB/BWF - VISTA SCHEDULING COMPENSATION AND PENSION RPCS ; Jan 23, 2023
+1 ;;5.3;Scheduling;**836,837,839**;Aug 13, 1993;Build 3
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ; Reference to DVBCUTL5 in ICR #7042
+4 ; Reference to DVBCCNNS in ICR #7038
+5 ; Reference to 2507 REQUEST in ICR #7044
+6 ; Reference to AMIE C&P EXAM TRACKING in ICR #7045
+7 ;
+8 QUIT
+9 ;
GET(RESULT,DFN,SDCL,SDT) ;GET entries from 2507 REQUEST file 396.3
+1 ;INPUT:
+2 ; DFN - (required) Patient ID pointer to PATIENT file 2
+3 ; SDCL - (required) Clinic ID pointer to HOSPITAL LOCATION file 44
+4 ; SDT - (required) Appointment Date/Time in external format
+5 ;
+6 NEW SDDA,ERRORS,RETURN
+7 SET DFN=$GET(DFN)
SET SDCL=$GET(SDCL)
SET SDT=$GET(SDT)
+8 ;validate DFN
+9 DO VALIDATEDFN^SDESINPUTVALUTL(.ERRORS,DFN)
+10 ;validate SDCL
+11 DO VALIDATECLINIC(.ERRORS,SDCL)
+12 IF $DATA(ERRORS)
Begin DoDot:1
+13 SET ERRORS("CompensationPensionRequest",1)=""
+14 DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
End DoDot:1
QUIT
+15 ;validate SDT
+16 SET SDT=$$VALDATE2^SDESVALUTIL(.ERRORS,SDT,SDCL,76,77)
+17 IF $DATA(ERRORS)
Begin DoDot:1
+18 SET ERRORS("CompensationPensionRequest",1)=""
+19 DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
End DoDot:1
QUIT
+20 SET SDDA=0
FOR
SET SDDA=$ORDER(^SC(SDCL,"S",SDT,1,SDDA))
if SDDA'>0
QUIT
if $PIECE($GET(^SC(SDCL,"S",SDT,1,SDDA,0)),U,1)=DFN
QUIT
+21 IF 'SDDA
DO ERRLOG^SDESJSON(.ERRORS,418)
+22 IF $DATA(ERRORS)
Begin DoDot:1
+23 SET ERRORS("CompensationPensionRequest",1)=""
+24 DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
End DoDot:1
QUIT
+25 DO GETREQUESTS(.RETURN,DFN,SDCL)
+26 IF '$DATA(RETURN)
SET RETURN("CompensationPensionRequest",1)=""
+27 DO BUILDJSON^SDESBUILDJSON(.RESULT,.RETURN)
+28 QUIT
+29 ;
+30 ;from DVBCMKLK
GETREQUESTS(RETURN,DFN,CLINIEN) ;
+1 NEW DVBADFN,DVBASDPR,DVBASTAT,CNT,DVBADA,SDINVERSE,SDREQDATE,REQIEN,SDLOOP,SDAMIEIEN,INITIALAPPTDT,ORIGAPPTDT,CURRAPPTDT,CLINNAME,LINKCNT,TMP
+2 ;**DVBASTAT used in REQARY^DVBCUTL5
SET DVBADFN=DFN
SET DVBASTAT="P"
+3 ; DVBADA/DVBASDPR initialized before calling REQARY^DVBCUTL5 since the function does not initialize
+4 SET (DVBADA,DVBASDPR)=""
+5 KILL ^TMP("DVBC",$JOB),TMP("DVBC LINK")
+6 ;**Set up ^TMP of AMIE 2507's
DO REQARY^DVBCUTL5
+7 ;^TMP("DVBC",8945,6889775.889799,3110224.1102,34231)=""
+8 ; Inverse REQUEST DATE, REQUEST DATE, IEN)
+9 SET CNT=0
+10 SET SDINVERSE=""
FOR
SET SDINVERSE=$ORDER(^TMP("DVBC",$JOB,SDINVERSE))
if SDINVERSE=""
QUIT
Begin DoDot:1
+11 SET SDREQDATE=""
FOR
SET SDREQDATE=$ORDER(^TMP("DVBC",$JOB,SDINVERSE,SDREQDATE))
if SDREQDATE=""
QUIT
Begin DoDot:2
+12 SET REQIEN=""
FOR
SET REQIEN=$ORDER(^TMP("DVBC",$JOB,SDINVERSE,SDREQDATE,REQIEN))
if REQIEN=""
QUIT
Begin DoDot:3
+13 SET CNT=CNT+1
+14 ; 2507 REQUEST ID
SET RETURN("CompensationPensionRequest",CNT,"RequestID")=REQIEN
+15 SET RETURN("CompensationPensionRequest",CNT,"PatientID")=DFN
+16 SET RETURN("CompensationPensionRequest",CNT,"PatientName")=$$GET1^DIQ(2,DFN_",",.01)
+17 SET RETURN("CompensationPensionRequest",CNT,"RequestDate")=$$FMTISO^SDAMUTDT(SDREQDATE,CLINIEN)
+18 SET RETURN("CompensationPensionRequest",CNT,"IsTrackedAmie")=+$EXTRACT($DATA(^DVB(396.95,"AR",REQIEN)),1)
+19 KILL TMP("DVBC LINK")
+20 SET LINKCNT=0
+21 DO LNKARY^DVBCUTA3(REQIEN,DFN)
+22 SET SDLOOP=""
FOR
SET SDLOOP=$ORDER(TMP("DVBC LINK",SDLOOP))
if SDLOOP=""
QUIT
Begin DoDot:4
+23 SET SDAMIEIEN=""
FOR
SET SDAMIEIEN=$ORDER(TMP("DVBC LINK",SDLOOP,SDAMIEIEN))
if SDAMIEIEN=""
QUIT
Begin DoDot:5
+24 SET INITIALAPPTDT=$$CONVDATE($PIECE(TMP("DVBC LINK",SDLOOP,SDAMIEIEN),U))
+25 SET ORIGAPPTDT=$$CONVDATE($PIECE(TMP("DVBC LINK",SDLOOP,SDAMIEIEN),U,2))
+26 SET CURRAPPTDT=$$CONVDATE($PIECE(TMP("DVBC LINK",SDLOOP,SDAMIEIEN),U,3))
+27 SET CLINNAME=$PIECE(TMP("DVBC LINK",SDLOOP,SDAMIEIEN),U,4)
+28 SET LINKCNT=LINKCNT+1
+29 SET RETURN("CompensationPensionRequest",CNT,"Links",LINKCNT,"AMIETrackingID")=SDAMIEIEN
+30 SET RETURN("CompensationPensionRequest",CNT,"Links",LINKCNT,"InitialAppointmentDate")=$$FMTISO^SDAMUTDT(INITIALAPPTDT,CLINIEN)
+31 SET RETURN("CompensationPensionRequest",CNT,"Links",LINKCNT,"OriginalAppointmentDate")=$$FMTISO^SDAMUTDT(ORIGAPPTDT,CLINIEN)
+32 SET RETURN("CompensationPensionRequest",CNT,"Links",LINKCNT,"CurrentAppointmentDate")=$$FMTISO^SDAMUTDT(CURRAPPTDT,CLINIEN)
+33 SET RETURN("CompensationPensionRequest",CNT,"Links",LINKCNT,"ClinicName")=CLINNAME
+34 SET RETURN("CompensationPensionRequest",CNT,"Links",LINKCNT,"ClinicID")=$$FIND1^DIC(44,,"B",CLINNAME)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+35 KILL ^TMP("DVBC",$JOB)
+36 KILL TMP("DVBC LINK")
+37 QUIT
+38 ; convert external date/time to fileman
CONVDATE(INDATE) ;
+1 NEW X,Y,%DT
+2 IF INDATE=""
QUIT ""
+3 SET %DT="ST"
+4 SET X=INDATE
DO ^%DT
+5 IF Y<1
QUIT ""
+6 QUIT Y
+7 ;
SET(RESULT,REQIEN,AMIETRKIEN,VETREQ,SDCL,SDT) ;SET entries to AMIE C&P EXAM TRACKING file 396.95 and update file 396.3
+1 ;INPUT:
+2 ; 1. REQIEN - (required) 2507 REQUEST id pointer to 2507 REQUEST file 396.3
+3 ; 2. AMIETRKIEN - (optional) Link ID - Pointer to AMIE C&P EXAM TRACKING file 396.95
+4 ; - This should ONLY be passed in if there is an AMIE tracking ID that is being updated.
+5 ; 3. VETREQ - (optional) Veteran Request flag - (field .04 in file 396.95)
+6 ; "Is this appointment due to a veteran requested cancellation or 'No Show'"
+7 ; 0=NO; 1=YES
+8 ; 4. SDCL - (required) pointer to HOSPITAL LOCATION file 44
+9 ; 5. SDT - (required) Appointment date/time in external format.
+10 ; The appointment date/time will be used as the original date if this is a new appointment
+11 ; The appointment date/time will be used as the 'reschedule' date if this is a re-schedule/update (AMIETRKIEN is passed in)
+12 ;
+13 NEW DFN,DVBALKRC,DVBAVTRQ,COMPPEN,SDDA,ERRORS
+14 SET REQIEN=$GET(REQIEN)
SET SDT=$GET(SDT)
SET SDCL=$GET(SDCL)
SET AMIETRKIEN=$GET(AMIETRKIEN)
SET VETREQ=$GET(VETREQ)
+15 ;validate REQIEN
+16 DO VALREQIEN(.ERRORS,REQIEN)
+17 ;validate VETREQ
+18 DO VALVETREQ(.ERRORS,VETREQ)
+19 ;validate SDCL
+20 DO VALIDATECLINIC(.ERRORS,SDCL)
+21 IF $DATA(ERRORS)
Begin DoDot:1
+22 SET ERRORS("CompensationPensionSet",1)=""
+23 DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
End DoDot:1
QUIT
+24 ;validate SDT
+25 SET SDT=$$VALDATE2^SDESVALUTIL(.ERRORS,SDT,SDCL,76,77)
+26 IF $DATA(ERRORS)
Begin DoDot:1
+27 SET ERRORS("CompensationPensionSet",1)=""
+28 DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
End DoDot:1
QUIT
+29 SET DFN=$$GET1^DIQ(396.3,REQIEN_",",.01,"I")
+30 SET SDDA=$$FIND^SDESCHECKOUT(DFN,SDT,SDCL)
+31 IF 'SDDA
DO ERRLOG^SDESJSON(.ERRORS,418)
+32 IF $GET(AMIETRKIEN)'=""
DO VALAMIEIEN(.ERRORS,AMIETRKIEN)
+33 IF $DATA(ERRORS)
Begin DoDot:1
+34 SET ERRORS("CompensationPensionSet",1)=""
+35 DO BUILDJSON^SDESBUILDJSON(.RESULT,.ERRORS)
End DoDot:1
QUIT
+36 IF AMIETRKIEN=""
Begin DoDot:1
+37 DO CRTREC(SDT,REQIEN,.AMIETRKIEN)
+38 SET COMPPEN("CompensationPensionSet","AMIETrackingRecordAdded")=AMIETRKIEN
+39 DO BUILDJSON^SDESBUILDJSON(.RESULT,.COMPPEN)
End DoDot:1
QUIT
+40 IF AMIETRKIEN'=""
Begin DoDot:1
+41 DO UPDTLK(AMIETRKIEN,SDT,VETREQ)
+42 SET COMPPEN("CompensationPensionSet","AMIETrackingRecordUpdated")=AMIETRKIEN
+43 DO BUILDJSON^SDESBUILDJSON(.RESULT,.COMPPEN)
End DoDot:1
QUIT
+44 IF '$DATA(COMPPEN)
SET COMPPEN("CompensationPensionSet",1)=""
+45 DO BUILDJSON^SDESBUILDJSON(.RESULT,.COMPPEN)
+46 QUIT
CRTREC(SDT,REQIEN,AMIETRKIEN) ;** Add a record to file 396.95 (Appt Tracking)
+1 NEW FDA,NEWAMIEIEN,AMIEERR
+2 SET FDA(396.95,"+1,",.01)=SDT
+3 SET FDA(396.95,"+1,",.02)=SDT
+4 SET FDA(396.95,"+1,",.03)=SDT
+5 SET FDA(396.95,"+1,",.04)=0
+6 SET FDA(396.95,"+1,",.06)=REQIEN
+7 SET FDA(396.95,"+1,",.07)=1
+8 DO UPDATE^DIE(,"FDA","NEWAMIEIEN","AMIEERR")
+9 SET AMIETRKIEN=$GET(NEWAMIEIEN(1))
+10 QUIT
UPDTLK(AMIETRKIEN,RSCHDT,VETREQ) ;** Update selected 396.95 link
+1 NEW FDA
+2 SET FDA(396.95,AMIETRKIEN_",",.03)=RSCHDT
+3 SET FDA(396.95,AMIETRKIEN_",",.07)=1
+4 IF $$GET1^DIQ(396.95,AMIETRKIEN,.04,"I")=0&('$GET(VETREQ))
Begin DoDot:1
+5 SET FDA(396.95,AMIETRKIEN_",",.02)=RSCHDT
End DoDot:1
+6 IF $GET(VETREQ)
Begin DoDot:1
+7 SET FDA(396.95,AMIETRKIEN_",",.04)=1
+8 SET FDA(396.95,AMIETRKIEN_",",.05)=RSCHDT
End DoDot:1
+9 DO FILE^DIE(,"FDA")
KILL FDA
+10 QUIT
AMIECAN(RETURN,DFN,APPTDTTM) ; update amie tracking for cancellations
+1 NEW AMIEIEN,DVBAAUTO,DVBAFND,DVBALKDA,REQIEN,DVBASTAT,DVBAUPDT,LNKCNT,APPTDTTME,MSGCNT
+2 ; DVBASTAT and DVBALKDA used by CANCEL^DVBCCNNS
+3 SET DVBASTAT=$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",3,"I")
+4 SET (AMIEIEN,DVBALKDA)=""
+5 SET (DVBAUPDT,LNKCNT,DVBAFND,MSGCNT,DVBAAUTO)=0
+6 FOR
SET AMIEIEN=$ORDER(^DVB(396.95,"CD",APPTDTTM,AMIEIEN))
if AMIEIEN=""
QUIT
Begin DoDot:1
+7 SET REQIEN=$$GET1^DIQ(396.95,AMIEIEN,.06,"I")
+8 IF $$GET1^DIQ(396.3,REQIEN,.01,"I")'=DFN
QUIT
+9 SET LNKCNT=LNKCNT+1
+10 IF $$GET1^DIQ(396.95,AMIEIEN,.07,"I")=1
SET DVBAFND=1
SET DVBALKDA=AMIEIEN
+11 IF 'DVBAFND
IF $$GET1^DIQ(396.95,AMIEIEN,.08,"I")>DVBAUPDT
Begin DoDot:2
+12 ;**Keep latest cancel dte
SET DVBAUPDT=$PIECE(^DVB(396.95,AMIEIEN,0),U,8)
+13 ;**Keep DA of rec last cancelled
SET DVBALKDA=AMIEIEN
End DoDot:2
End DoDot:1
+14 IF (DVBASTAT="PCA")!((DVBASTAT="NA")!(DVBASTAT="CA"))
SET DVBAAUTO=1
+15 ;** Appt not linked
+16 IF LNKCNT=0
Begin DoDot:1
+17 SET APPTDTTME=$$FMTE^XLFDT(APPTDTTM)
+18 SET MSGCNT=MSGCNT+1
+19 SET RETURN("CompensationPensionCancel",MSGCNT,"Text")="Appointment "_APPTDTTME_" was not linked to a 2507 request or was manually rebooked and linked to another appointment."
+20 SET MSGCNT=MSGCNT+1
+21 SET RETURN("CompensationPensionCancel",MSGCNT,"Text")="If the appointment was manually rebooked, you do not want to auto-rebook."
+22 SET MSGCNT=MSGCNT+1
+23 SET RETURN("CompensationPensionCancel",MSGCNT,"Text")="If the appointment was not properly linked, it will need to be linked with the AMIE/C&P appointment link management option."
End DoDot:1
+24 ;**Appt linked, not Auto
IF 'DVBAAUTO
IF (DVBAFND)
Begin DoDot:1
+25 DO CANCEL^DVBCCNNS
+26 SET RETURN("CompensationPensionCancel","Status")="The AMIE C&P Tracking link has been updated."
+27 SET RETURN("CompensationPensionCancel","AmieID")=DVBALKDA
End DoDot:1
+28 IF +LNKCNT>1
Begin DoDot:1
+29 SET MSGCNT=MSGCNT+1
+30 SET RETURN("CompensationPensionCancel",MSGCNT,"Text")="This C&P appointment has multiple links with the same Current Appt Date. Use the AMIE/C&P Appointment Link Management option to review and delete any duplicate links."
End DoDot:1
+31 QUIT
+32 ; validate clinic
VALIDATECLINIC(ERRORS,CLINICIEN) ;
+1 IF CLINICIEN=""
DO ERRLOG^SDESJSON(.ERRORS,18)
QUIT
+2 IF '$DATA(^SC(CLINICIEN,0))
DO ERRLOG^SDESJSON(.ERRORS,19)
QUIT
+3 QUIT
+4 ; validate request ien
VALREQIEN(ERRORS,REQIEN) ;
+1 IF REQIEN=""
DO ERRLOG^SDESJSON(.ERRORS,419)
QUIT
+2 IF '$DATA(^DVB(396.3,REQIEN))
DO ERRLOG^SDESJSON(.ERRORS,420)
+3 QUIT
VALVETREQ(ERRORS,VETREQ) ;
+1 IF VETREQ'=1
IF VETREQ'=""
IF VETREQ'=0
DO ERRLOG^SDESJSON(.ERRORS,422)
+2 QUIT
VALAMIEIEN(ERRORS,AMIEIEN) ;
+1 IF 'AMIETRKIEN!('$DATA(^DVB(396.95,AMIEIEN)))
DO ERRLOG^SDESJSON(.ERRORS,421)
+2 QUIT
+3 ;
