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 Nov 22, 2024@17:38:26 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
