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

IBTRHDE.m

Go to the documentation of this file. 
  1. IBTRHDE ;ALB/FA - HCSR Patient Events Search ;06-JUN-2014
  1.  ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. EN(NOMSG) ;EP
  1.  ; Called from menu option: IBT HCSR NIGHTLY PROCESS designed to be scheduled
  1.  ; in TaskMan to be executed once a day during off-peak hours
  1.  ; Use HCSR Site Parameters to set appointment search criteria and filter
  1.  ; appointments.  File any appointments that match the criteria into 356.22,
  1.  ; the HCS Review Transmission file
  1.  ; Input:   NOMSG       - 1 to not display locked message. Only set to 1 when
  1.  ;                          called from REFRESH^IBTRH1A to refresh the worklist
  1.  ;                          screen.
  1.  ;                          Optional, defaults to 0
  1.  N $ES,$ET,HCSR
  1.  S:'$D(NOMSG) NOMSG=0
  1.  S $ET="D ER^IBTRHDE"
  1.  ;
  1.  ; Check lock
  1.  L +^TMP("IBTRHDE"):1
  1.  I '$T D  Q
  1.  . I '$D(ZTSK),'NOMSG D
  1.  . . W !!,"The IBT HCSR Nightly Process is already running, please retry later."
  1.  . . D PAUSE^VALM1
  1.  . D ENX
  1.  ;
  1.  ; Check to see if background process has been stopped, if so quit.
  1.  I $G(ZTSTOP) D ENX Q
  1.  S HCSR=$G(^IBE(350.9,1,62))                    ; HCSR Site Parameters
  1.  ; First find all of the scheduled appointments that match the filter criteria
  1.  ;;D FAPPTS(HCSR) ;3/21/16 JWS commented out background job creation of worklist entries
  1.  ;
  1.  ; Check to see if background process has been stopped, if so quit.
  1.  I $G(ZTSTOP) D ENX Q
  1.  ;
  1.  ; Next find all of the admissions that match the filter criteria
  1.  ;;D FADMS(HCSR)  ;3/21/16 JWS commented out background job creation of worklist entries
  1.  ;
  1.  ; Check to see if background process has been stopped, if so quit.
  1.  I $G(ZTSTOP) D ENX Q
  1.  ; JWS 10/13/14 add 278x215 auto create
  1.  ; perform auto 278x215 Inquiry generation
  1.  ;;I $P(HCSR,"^",10)!($P(HCSR,"^",11)) D TRIG278^IBTRHDE1  ;3/21/16 JWS commented out auto-generated 278x215s
  1.  ; Check to see if background process has been stopped, if so quit.
  1.  I $G(ZTSTOP) D ENX Q
  1.  ;
  1.  ; Finally automatically purge events
  1.  D PURGE(HCSR)
  1.  D ENX
  1.  Q
  1.  ;
  1. ENX ; Purge task record - if queued
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  L -^TMP("IBTRHDE")
  1.  Q
  1.  ;
  1. FAPPTS(HCSR)    ; Finds all appointments that match the filter criteria. Each
  1.  ; found appointment is then further filtered using the HCSR Site Parameters.
  1.  ; Appointments that match the filter criteria are then filed into the HCS 
  1.  ; Review Transmission file (356.22)
  1.  ; Input:   HSCR    - HCSR Site Parameter filters
  1.  ; Output:  Filtered appointments filed into 356.22
  1.  N ADATE,AINS,AINSIX,CLINIC,DFN,INSIEN,SDATE,SDCOUNT,SFILT,XX,NODE0
  1.  K ^TMP($J,"SDAMA301")
  1.  D SETFILTS(HCSR,.SFILT)                        ; Set Appointment filters
  1.  S SDCOUNT=$$SDAPI^SDAMA301(.SFILT)             ; Find the appointments, DBIA4433
  1.  Q:SDCOUNT<1                                    ; No appointments returned
  1.  ;
  1.  ; Check the active insurance for every found filter against the HCSR Site 
  1.  ; parameter list of insurance companies to exclude
  1.  S DFN="" F  S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:DFN=""  D
  1.  .; loop through Appointment Date/time
  1.  .S ADATE="" F  S ADATE=$O(^TMP($J,"SDAMA301",DFN,ADATE)) Q:ADATE=""  D
  1.  ..D CKAFINS(HCSR,DFN,ADATE,65,.AINS)         ; Check for valid Insurance(s)
  1.  ..S AINSIX="" F  S AINSIX=$O(AINS(AINSIX)) Q:AINSIX=""  D
  1.  ...S CLINIC=$P($P(^TMP($J,"SDAMA301",DFN,ADATE),U,2),";",1)
  1.  ...; check for clinic inclusion
  1.  ...; 8/20/15 jws - if clinic is not defined
  1.  ...I '$O(^IBE(350.9,1,63,"B",CLINIC,"")) Q
  1.  ...I '$$CHKLIST(63,$O(^IBE(350.9,1,63,"B",CLINIC,"")),$P(AINS(AINSIX),U)) Q
  1.  ...; File the event
  1.  ...; Appointment Date/Time is the 'IEN' of the appointment
  1.  ...S NODE0=$$NOW^XLFDT()_U_DFN_U_AINSIX_"^O^^"_CLINIC_U_ADATE_U_ADATE
  1.  ...D SETEVENT(NODE0)
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  K ^TMP($J,"SDAMA301")
  1.  Q
  1.  ;
  1. FADMS(HCSR)    ; Finds all admissions that match the filter criteria. Each found
  1.  ; admission is then further filtered using the HCSR Site Parameters. 
  1.  ; Admissions that match the filter criteria are then filed into the HCS 
  1.  ; Review Transmission file (356.22)
  1.  ; Input:   HSCR    - HCSR Site Parameter filters
  1.  ; Output:  Filtered admissions filed into 356.22
  1.  N AINS,AINSIX,DA,DATEC,DATEE,DATES,DFN,IBWARD,NODE0,XX,YY
  1.  D GETDAYS2(HCSR,.DATES,.DATEE)
  1.  D DT^DILF("","T-"_(DATES-1),.DATEC)             ; Past Admission Search date
  1.  D DT^DILF("","T+"_DATEE,.DATEE)                 ; Future Admission Search date
  1.  ;
  1.  ; First check past/present admissions
  1.  F  S DATEC=$O(^DGPM("AMV1",DATEC)) Q:(DATEC="")!($P(DATEC,".")>DATEE)  D  ; DBIA419
  1.  .S DFN="" F  S DFN=$O(^DGPM("AMV1",DATEC,DFN)) Q:DFN=""  D
  1.  ..S DA="" F  S DA=$O(^DGPM("AMV1",DATEC,DFN,DA)) Q:DA=""  D
  1.  ...S IBWARD=$$GET1^DIQ(405,DA_",",.06,"I")
  1.  ...D CKAFINS(HCSR,DFN,DATEC,66,.AINS)       ; Check for valid Insurance(s)
  1.  ...S AINSIX="" F  S AINSIX=$O(AINS(AINSIX)) Q:AINSIX=""  D
  1.  ....; check for ward inclusion
  1.  ....; 8/20/15 jws - if ward is not defined
  1.  ....I '$O(^IBE(350.9,1,64,"B",IBWARD,"")) Q
  1.  ....I '$$CHKLIST(64,$O(^IBE(350.9,1,64,"B",IBWARD,"")),$P(AINS(AINSIX),U)) Q
  1.  ....; File the event
  1.  ....S XX=DATEC
  1.  ....S YY=$$GET1^DIQ(405,DA_",",.17,"I")    ; Is there a Discharge
  1.  ....I YY'="" D                             ; Get External Discharge Date
  1.  .....S YY=$$GET1^DIQ(405,DA_",",.01,"I")   ; Discharge Date/Time
  1.  .....S XX=XX_"-"_YY
  1.  .....Q
  1.  ....S NODE0=$$NOW^XLFDT()_U_DFN_U_AINSIX_"^I^"_IBWARD_"^^"_XX_U_$P(DATEC,".",1)
  1.  ....D SETEVENT(NODE0)
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  ;
  1.  ; Next check future admissions
  1.  D DT^DILF("","T-"_(DATES-1),.DATEC)             ; Past Admission Search date
  1.  F  S DATEC=$O(^DGS(41.1,"C",DATEC)) Q:(DATEC="")!($P(DATEC,".")>DATEE)  D  ; DBIA429
  1.  .S DA="" F  S DA=$O(^DGS(41.1,"C",DATEC,DA)) Q:DA=""  D
  1.  ..Q:$P($G(^DGS(41.1,DA,0)),U,13)'=""            ; Future Admission was cancelled
  1.  ..S IBWARD=$$GET1^DIQ(41.1,DA_",",8,"I")
  1.  ..S DFN=$$GET1^DIQ(41.1,DA_",",.01,"I")         ; Patient DFN
  1.  ..D CKAFINS(HCSR,DFN,DATEC,66,.AINS)            ; Check for valid Insurance(s)
  1.  ..S AINSIX="" F  S AINSIX=$O(AINS(AINSIX)) Q:AINSIX=""  D
  1.  ...; check for ward inclusion
  1.  ...I '$$CHKLIST(64,$O(^IBE(350.9,1,64,"B",IBWARD,"")),$P(AINS(AINSIX),U)) Q
  1.  ...; File the event
  1.  ...S NODE0=$$NOW^XLFDT()_U_DFN_U_AINSIX_"^I^"_IBWARD_"^^"_DATEC_U_$P(DATEC,".",1)
  1.  ...D SETEVENT(NODE0)
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1. PURGE(HCSR)    ; Purge events that were created based upon the HCSR purge
  1.  ; parameter
  1.  ; Input:   HSCR    - HCSR Site Parameter filters
  1.  ; Output:  Events are deleted from into 356.22
  1.  N DA,DIK,PDATE,PDAYS,TDATE
  1.  S PDAYS=$P(HCSR,"^",9)                         ; Purge Days Parameter
  1.  D DT^DILF("","T-"_PDAYS,.PDATE)                ; Purge events up to PDATE
  1.  S DIK="^IBT(356.22,"
  1.  S TDATE=PDATE
  1.  F  D  Q:(TDATE="")!(TDATE'<PDATE)
  1.  . S TDATE=$O(^IBT(356.22,"B",TDATE),-1)
  1.  . Q:(TDATE="")!(TDATE'<PDATE)
  1.  . S DA=""
  1.  . F  D  Q:DA=""
  1.  . . S DA=$O(^IBT(356.22,"B",TDATE,DA))
  1.  . . Q:DA=""
  1.  . . D ^DIK
  1.  Q
  1.  ;
  1. SETFILTS(HCSR,SFILT) ; Set the Appointment Search filters
  1.  ; Input:   HCSR    - HCSR Site Parameters
  1.  ; Output:  SFILT() - Array of Appointment Search filters
  1.  N DATEE,DATES,SDATE,IX,IEN
  1.  ;
  1.  ; Determine the maximum date range to be searched
  1.  D GETDAYS1(HCSR,.DATES,.DATEE)
  1.  D DT^DILF("","T-"_DATES,.SDATE)                ; Past Appt Search date
  1.  S SFILT(1)=SDATE
  1.  D DT^DILF("","T+"_DATEE,.SDATE)                ; Future Appt Search date
  1.  S $P(SFILT(1),";",2)=SDATE
  1.  S SFILT(3)="R;I;NT"                            ; Schedule/Kept Appointment filter
  1.  S SFILT("FLDS")="1;2;3;4;10;12"                ; list of fields to return
  1.  S SFILT("SORT")="P"                            ; Sort by Patient DFN only
  1.  Q
  1.  ;
  1. GETDAYS1(HCSR,DATES,DATEE)    ; Checks the HCSR Site Parameters to get the 
  1.  ; maximum date range to be use when search for appointments
  1.  ; Input:       HCSR    - HCSR Site Parameters
  1.  ; Output:      DATES   - Internal fileman date to begin start search on
  1.  ;              DATEE   - Internal fileman date to end search after
  1.  ;
  1.  ; Find the site parameter with the greatest number of days
  1.  S DATES=$P(HCSR,"^",3)                         ; Past Appointment Search Days
  1.  S:$P(HCSR,"^",7)>DATES DATES=$P(HCSR,"^",7)    ; TRICARE Past Appt Search Days
  1.  ;
  1.  ; Find the site parameter with the greatest number of days
  1.  S DATEE=$P(HCSR,"^",13)                        ; Future Appointment Search Days
  1.  S:$P(HCSR,"^",5)>DATEE DATEE=$P(HCSR,"^",5)    ; TRICARE Future Appt Search Days
  1.  Q
  1.  ;
  1. GETDAYS2(HCSR,DATES,DATEE)    ; Checks the HCSR Site Parameters to get the 
  1.  ; maximum date range to use when searching for admissions
  1.  ; Input:       HCSR    - HCSR Site Parameters
  1.  ; Output:      DATES   - Internal fileman date to begin start search on
  1.  ;              DATEE   - Internal fileman date to end search after
  1.  ;
  1.  ; Find the site parameter with the greatest number of days
  1.  S DATES=$P(HCSR,"^",4)                         ; Past Admission Search Days
  1.  S:$P(HCSR,"^",8)>DATES DATES=$P(HCSR,"^",8)    ; TRICARE Past Admission Search Days
  1.  ;
  1.  ; Find the site parameter with the greatest number of days
  1.  S DATEE=$P(HCSR,"^",2)                         ; Future Admission Search Days
  1.  S:$P(HCSR,"^",6)>DATEE DATEE=$P(HCSR,"^",6)    ; TRICARE future Admission Search Days
  1.  Q
  1.  ;
  1. CKAFINS(HCSR,DFN,ADATE,WHICH,AINS,DATECHK)    ; Checks to see if the selected patient
  1.  ; has active insurance(S) that are valid for HCSR Site Parameter filter 
  1.  ; criteria
  1.  ; Input:       HCSR    - HCSR Site Parameters
  1.  ;              DFN     - Internal Patient IEN
  1.  ;              ADATE   - Internal Fileman date to check for 'active'
  1.  ;              WHICH   - 65 - Checking for an appointment
  1.  ;                        66 - Checking for an admission
  1.  ; Output:      AINS()  - Array of all of the active insurances that are valid
  1.  N COB,IBWARD,INSDATA,INSIEN,INSIX,INSNAME,STOP,TDATE,TRICARE,XX
  1.  K AINS
  1.  D ALL^IBCNS1(DFN,"INSDATA",1,ADATE)
  1.  ;
  1.  ; No active insurance for specified date
  1.  I '$G(INSDATA(0)) Q 0
  1.  S INSIX=0
  1.  F  D  Q:+INSIX=0
  1.  . S INSIX=$O(INSDATA(INSIX))
  1.  . Q:+INSIX=0
  1.  . S TRICARE=0,STOP=0
  1.  . S INSIEN=$P(INSDATA(INSIX,0),"^",1)
  1.  . S COB=$P(INSDATA(INSIX,0),"^",20)
  1.  . S INSNAME=$$GET1^DIQ(36,INSIEN_",",.01)      ; Insurance Company Name
  1.  . S INSNAME=$$UP^XLFSTR(INSNAME)
  1.  . I (INSNAME["TRICARE")!(INSNAME["CHAMPVA") D
  1.  . . S TRICARE=1
  1.  . ; 
  1.  . ; Check if the Insurance is TRICARE or CHAMPVA and then make sure that the
  1.  . ; date being checked is valid for the type of insurance
  1.  . I WHICH=65,'+$G(DATECHK) D  Q:STOP
  1.  . . I 'TRICARE D  Q
  1.  . . . S XX=$P(HCSR,"^",3)                      ; Past Appt Days
  1.  . . . D DT^DILF("","T-"_XX,.TDATE)             ; Past Appt Search date
  1.  . . . I ADATE<TDATE S STOP=1 Q                 ; Date<Past Appt Date
  1.  . . . S XX=$P(HCSR,"^",13)                     ; Future Appt Days
  1.  . . . D DT^DILF("","T+"_XX,.TDATE)             ; Future Appt Search date
  1.  . . . I ADATE>TDATE S STOP=1 Q                 ; Date>Future Appt Date
  1.  . . S XX=$P(HCSR,"^",7)                        ; TRICARE Past Appt Days
  1.  . . D DT^DILF("","T-"_XX,.TDATE)               ; TRICARE Past Appt Search date
  1.  . . I ADATE<TDATE S STOP=1 Q                   ; Date<Past TRICARE Appt Date
  1.  . . S XX=$P(HCSR,"^",5)                        ; TRICARE Future Appt Days
  1.  . . D DT^DILF("","T+"_XX,.TDATE)               ; TRICARE Future Appt Search date
  1.  . . I ADATE>TDATE S STOP=1 Q                   ; Date>Future TRICARE Appt Date
  1.  . ;
  1.  . I WHICH=66,'+$G(DATECHK) D  Q:STOP
  1.  . . I 'TRICARE D  Q
  1.  . . . S XX=$P(HCSR,"^",4)                      ; Past Admission Days
  1.  . . . D DT^DILF("","T-"_XX,.TDATE)             ; Past Admission Search date
  1.  . . . I ADATE<TDATE S STOP=1 Q                 ; Date<Past Admission Date
  1.  . . . S XX=$P(HCSR,"^",2)                      ; Future Admission Days
  1.  . . . D DT^DILF("","T+"_XX,.TDATE)             ; Future Admission Search date
  1.  . . . I ADATE>TDATE S STOP=1 Q                 ; Date>Future Admission Date
  1.  . . S XX=$P(HCSR,"^",8)                        ; TRICARE Past Admission Days
  1.  . . D DT^DILF("","T-"_XX,.TDATE)               ; TRICARE Past Admission Search date
  1.  . . I ADATE<TDATE S STOP=1 Q                   ; Date<Past TRICARE Admission Date
  1.  . . S XX=$P(HCSR,"^",6)                        ; TRICARE Future Admission Days
  1.  . . D DT^DILF("","T+"_XX,.TDATE)               ; TRICARE Future Admission Search date
  1.  . . I ADATE>TDATE S STOP=1 Q                   ; Date>Future TRICARE Admission Date
  1.  . ;
  1.  . I $D(^IBE(350.9,1,WHICH,"B",INSIEN)) D       ; On the inclusion list
  1.  . . S AINS(INSIX)=INSIEN_"^"_COB
  1.  Q
  1.  ;
  1. SETEVENT(NODE0) ; Set Events into the HCS Review Transmission file (356.22)
  1.  ; Input:   NODE0 - A1^A2^...^An Where:
  1.  ;                    A1  - External date of when event was filed
  1.  ;                    A2  - Internal Patient DFN event is for
  1.  ;                    A3  - Insurance multiple IEN
  1.  ;                    A4  - Status. 'I' for Admission, 'O' for appointment
  1.  ;                    A5  - Internal Ward IEN (file 42) if event is an 
  1.  ;                          admission, null otherwise
  1.  ;                    A6  - Internal Clinic IEN (file 44) if event is an 
  1.  ;                          appointment, null otherwise
  1.  ;                    A7  - Internal fileman date (or date range) of the event
  1.  ;                          (appointment or admission date)
  1.  ;                          NOTE: if admission, this is B1-B2 Where:
  1.  ;                                  B1 - Internal Admission Start Date
  1.  ;                                  B2 - Internal Admission Discharge Date
  1.  ;                    A8  - Source identifier - Internal fileman date/time of
  1.  ;                          the appointment or the Internal fileman date of the
  1.  ;                          admission that caused the event creation.  Used in
  1.  ;                          Conjunction with the patient's DFN and Insurance IEN
  1.  ;                          to prevent the creation of 'duplicate' entries
  1.  ; Output:  Event is filed into the HCS Review Transmission file (356.22)
  1.  N DFN,FDA,IEN,INSMIEN,SOURCE,STATUS
  1.  S DFN=$P(NODE0,"^",2)
  1.  S STATUS=$P(NODE0,"^",4)
  1.  S SOURCE=$P(NODE0,"^",8)
  1.  S INSMIEN=$P(NODE0,"^",3)
  1.  ;
  1.  ; Quit if we already have an event for this Status, Ins IEN and Source IEN
  1.  Q:$D(^IBT(356.22,"E",DFN,STATUS,INSMIEN,SOURCE))
  1.  ;
  1.  S FDA(356.22,"+1,",.01)=$P(NODE0,"^",1)
  1.  S FDA(356.22,"+1,",.02)=DFN
  1.  S FDA(356.22,"+1,",.03)=INSMIEN
  1.  S FDA(356.22,"+1,",.04)=STATUS
  1.  S FDA(356.22,"+1,",.05)=$P(NODE0,"^",5)
  1.  S FDA(356.22,"+1,",.06)=$P(NODE0,"^",6)
  1.  S FDA(356.22,"+1,",.08)=0   ; Set initial status to 0
  1.  S FDA(356.22,"+1,",.07)=$P($P(NODE0,U,7),"-")  ; force single date
  1.  ; IF $P($P(NODE0,"^",7),"-",2)'="" S FDA(356.22,"+1,",2.22)=$P($P($P(NODE0,"^",7),"-",2),".")
  1.  S FDA(356.22,"+1,",.16)=SOURCE
  1.  ; JWS 4/2/15 added check for service line data, then if HSD 01 and HSD 02 values do not exist for 2000E loop, default
  1.  ; them to HSD01='VS' and HSD02=1 for outpatient, HSD01='DY' and HSD02=1 for inpatient
  1.  S FDA(356.22,"+1,",4.01)=$$FIND1^DIC(365.016,,,$S(STATUS="I":"DY",1:"VS"))  ; quantity qualifier
  1.  S FDA(356.22,"+1,",4.02)=1  ; unit count
  1.  D UPDATE^DIE("","FDA")
  1.  Q
  1.  ;
  1. ER ; Unlock the IBT HCSR Nightly Process and return to log error
  1.  L -^TMP("IBTRHDE")
  1.  D ^%ZTER
  1.  D UNWIND^%ZTER
  1.  Q
  1.  ;
  1. CHKLIST(NODE,LISTIEN,INSIEN) ; check site parameters and determine if clinic/ward + payer combination is on the list
  1.  ;
  1.  ; NODE = 63 - for Clinic Search inclusion list
  1.  ;        64 - for Ward Search inclusion list
  1.  ;
  1.  ; LISTIEN - IEN in sub-file 350.963 for clinics or 350.964 for wards
  1.  ;
  1.  ; INSIEN - IEN in file 36
  1.  ;
  1.  ; returns 1 if clinic + payer or ward + payer should be included, 0 otherwise
  1.  ;
  1.  N PYRIEN,RES,Z
  1.  S RES=0
  1.  I +$G(LISTIEN),+$G(INSIEN) D
  1.  .; file event if clinic / ward is associated with all payers
  1.  .I $$ISALL^IBJPC3(NODE,LISTIEN) S RES=1 Q
  1.  .; don't file event if clinic / ward is associated with zero payers
  1.  .I $$GETTOT^IBJPC3(NODE,LISTIEN)'>0 S RES=0 Q
  1.  .S PYRIEN=+$$GET1^DIQ(36,INSIEN_",",3.1,"I") I PYRIEN'>0 Q
  1.  .; if payer associated with this ins. co. is on the list - file event
  1.  .I +$O(^IBE(350.9,1,NODE,LISTIEN,1,"B",PYRIEN,""))>0 S RES=1
  1.  .Q
  1.  Q RES