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

SDESCOMPPEN.m

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