- IBTRHDE1 ;ALB/JWS - HCSR Auto Trigger of 278x215 Inquiry ;15-OCT-2014
- ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- Q
- ;
- TRIG278 ; Perform 278x215 Inquiry Trigger for Appointments and Admissions
- ; loop through ^IBT(356.22,"AC") index, from today minus (-) HCSR100[1] and [2]
- ; check for only previous requests and/or inquiries that have received a 'pending' response
- ; added field .19 to 356.22 file to indicate that a 215 had been generated for the request/inquiry in order to
- ; prevent duplicates
- ; once entry found, perform copy of request data into new 356.22 entry (use version of IBTRH5C)
- ; need to suppress output of any error results during copy
- ; perform D EN^IBTRHLO(ien#, 1) to transmit 278x215
- ;
- N APPTDATE,ADMDATE,IEN,DATA0,IBTRIEN,TDATE,IBFDA
- I $P(HCSR,"^",10) D DT^DILF("","T-"_$P(HCSR,"^",10),.APPTDATE)
- I $P(HCSR,"^",11) D DT^DILF("","T-"_$P(HCSR,"^",11),.ADMDATE)
- I '$G(APPTDATE),'$G(ADMDATE) Q
- I $G(APPTDATE),'$G(ADMDATE) S TDATE=APPTDATE G 1
- I $G(ADMDATE),'$G(APPTDATE) S TDATE=ADMDATE G 1
- S TDATE=$S(APPTDATE<ADMDATE:APPTDATE,1:ADMDATE)
- 1 ;begin SEARCH and copy and transmit 215 version of 278 authorization message
- S TDATE=TDATE_".999999"
- F S TDATE=$O(^IBT(356.22,"AC",TDATE),-1) Q:TDATE="" D
- . S IEN="" F S IEN=$O(^IBT(356.22,"AC",TDATE,IEN)) Q:IEN="" S DATA0=$G(^IBT(356.22,IEN,0)) I '$P(DATA0,"^",19) D
- .. I $P(DATA0,"^",13) Q ;THIS IS A RESPONSE MESSAGE ENTRY
- .. I '$P(DATA0,"^",14) Q ;NO RESPONSE RECEIVED YET FOR THIS REQUEST/INQUIRY
- .. I $P(DATA0,"^",8)'="07" Q ;ONLY AUTO-GENERATE 215 FOR PENDING ENTRIES
- .. I $P(DATA0,"^",4)="O",+TDATE>APPTDATE Q
- .. I $P(DATA0,"^",4)="I",+TDATE>ADMDATE Q ; Perform Inquiry Trigger for Admissions
- .. S IBTRIEN=$$CRTENTRY^IBTRH5C(IEN,$P(DATA0,"^",14),$P(DATA0,"^",3),"",0,"",1) ; create new 356.22 entry for 215 inquiry
- .. I 'IBTRIEN Q ;COPY FAILED
- .. S IBFDA(356.22,IBTRIEN_",",.2)=1
- .. D FILE^DIE("I","IBFDA","ERROR")
- .. S IBFDA(356.22,IEN_",",.19)=1 ;flag request/inquiry that we have generated a 215
- .. D FILE^DIE("I","IBFDA","ERROR")
- .. D EN^IBTRHLO(IBTRIEN,1) ;transmit 215
- . Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRHDE1 2210 printed Mar 13, 2025@21:33:23 Page 2
- IBTRHDE1 ;ALB/JWS - HCSR Auto Trigger of 278x215 Inquiry ;15-OCT-2014
- +1 ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 QUIT
- +5 ;
- TRIG278 ; Perform 278x215 Inquiry Trigger for Appointments and Admissions
- +1 ; loop through ^IBT(356.22,"AC") index, from today minus (-) HCSR100[1] and [2]
- +2 ; check for only previous requests and/or inquiries that have received a 'pending' response
- +3 ; added field .19 to 356.22 file to indicate that a 215 had been generated for the request/inquiry in order to
- +4 ; prevent duplicates
- +5 ; once entry found, perform copy of request data into new 356.22 entry (use version of IBTRH5C)
- +6 ; need to suppress output of any error results during copy
- +7 ; perform D EN^IBTRHLO(ien#, 1) to transmit 278x215
- +8 ;
- +9 NEW APPTDATE,ADMDATE,IEN,DATA0,IBTRIEN,TDATE,IBFDA
- +10 IF $PIECE(HCSR,"^",10)
- DO DT^DILF("","T-"_$PIECE(HCSR,"^",10),.APPTDATE)
- +11 IF $PIECE(HCSR,"^",11)
- DO DT^DILF("","T-"_$PIECE(HCSR,"^",11),.ADMDATE)
- +12 IF '$GET(APPTDATE)
- IF '$GET(ADMDATE)
- QUIT
- +13 IF $GET(APPTDATE)
- IF '$GET(ADMDATE)
- SET TDATE=APPTDATE
- GOTO 1
- +14 IF $GET(ADMDATE)
- IF '$GET(APPTDATE)
- SET TDATE=ADMDATE
- GOTO 1
- +15 SET TDATE=$SELECT(APPTDATE<ADMDATE:APPTDATE,1:ADMDATE)
- 1 ;begin SEARCH and copy and transmit 215 version of 278 authorization message
- +1 SET TDATE=TDATE_".999999"
- +2 FOR
- SET TDATE=$ORDER(^IBT(356.22,"AC",TDATE),-1)
- if TDATE=""
- QUIT
- Begin DoDot:1
- +3 SET IEN=""
- FOR
- SET IEN=$ORDER(^IBT(356.22,"AC",TDATE,IEN))
- if IEN=""
- QUIT
- SET DATA0=$GET(^IBT(356.22,IEN,0))
- IF '$PIECE(DATA0,"^",19)
- Begin DoDot:2
- +4 ;THIS IS A RESPONSE MESSAGE ENTRY
- IF $PIECE(DATA0,"^",13)
- QUIT
- +5 ;NO RESPONSE RECEIVED YET FOR THIS REQUEST/INQUIRY
- IF '$PIECE(DATA0,"^",14)
- QUIT
- +6 ;ONLY AUTO-GENERATE 215 FOR PENDING ENTRIES
- IF $PIECE(DATA0,"^",8)'="07"
- QUIT
- +7 IF $PIECE(DATA0,"^",4)="O"
- IF +TDATE>APPTDATE
- QUIT
- +8 ; Perform Inquiry Trigger for Admissions
- IF $PIECE(DATA0,"^",4)="I"
- IF +TDATE>ADMDATE
- QUIT
- +9 ; create new 356.22 entry for 215 inquiry
- SET IBTRIEN=$$CRTENTRY^IBTRH5C(IEN,$PIECE(DATA0,"^",14),$PIECE(DATA0,"^",3),"",0,"",1)
- +10 ;COPY FAILED
- IF 'IBTRIEN
- QUIT
- +11 SET IBFDA(356.22,IBTRIEN_",",.2)=1
- +12 DO FILE^DIE("I","IBFDA","ERROR")
- +13 ;flag request/inquiry that we have generated a 215
- SET IBFDA(356.22,IEN_",",.19)=1
- +14 DO FILE^DIE("I","IBFDA","ERROR")
- +15 ;transmit 215
- DO EN^IBTRHLO(IBTRIEN,1)
- End DoDot:2
- +16 QUIT
- End DoDot:1
- +17 QUIT
