- 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 Feb 19, 2025@00:22:49 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 ;