IBTRHLI1 ;ALB/JWS - Receive and store 278 Response message ;05-JUN-2014
;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
;;Per VA Directive 6402, this routine should not be modified.
;
;**Program Description**
; This program will process incoming HCS REVIEW TRANSMISSION FILE (356.22) ^IBT(356.22).
; This includes updating the record in the HCSR IIV Response File
;
; Variables
; SEG = HL7 Segment Name
; RESIEN = Response Record IEN
; ERROR = processing error condition flag
; IBSEG = array of segment field data values
EN ; Entry Point
N ERROR,HLCMP,HLREP,HLSCMP,RESIEN,SEG,SLIEN,PEIEN,SLPIEN,REQIEN,HCT,IBSEG,BADERROR,STATUS
K ^TMP($J,"IBTRHLI2")
S HCT=0
S HLCMP=$E(HL("ECH")) ; HL7 component separator
S HLSCMP=$E(HL("ECH"),4) ; HL7 subcomponent separator
S HLREP=$E(HL("ECH"),2) ; HL7 repetition separator
; Loop through the message and find each segment for processing
F S HCT=$O(^TMP($J,"IBTRHLI",HCT)) Q:HCT="" D Q:$D(BADERROR)
. D SPAR^IBTRHLU ; returns all segment fields in IBSEG(field#) array
. S SEG=$G(IBSEG(0))
. I SEG="MSH" D MSH^IBTRHLI2(.IBSEG,.RESIEN,.ERROR) Q
. I SEG="EVN" Q
. I SEG="MSA" D MSA^IBTRHLI2(.IBSEG,.RESIEN,.ERROR) Q
. I SEG="IN1" D IN1^IBTRHLI2(.IBSEG,.RESIEN,.ERROR) Q
. I SEG="PV1" D PV1^IBTRHLI2(.IBSEG,.RESIEN,.ERROR) Q
. I SEG="PRD" D Q
.. I $P($G(IBSEG(1)),HLCMP,4)="NM1 2010B" Q
.. I $P($G(IBSEG(1)),HLCMP,4)="PRV 2010B" Q
.. I $P($G(IBSEG(1)),HLCMP,4)="NM1 2010EA" D PRD^IBTRHLI2(.IBSEG,.RESIEN,.ERROR,.PEIEN,.SLIEN,.SLPIEN) Q
.. I $P($G(IBSEG(1)),HLCMP,4)="PRV 2010EA" Q
.. I $P($G(IBSEG(1)),HLCMP,4)="NM1 2010EC" D PRD^IBTRHLI2(.IBSEG,.RESIEN,.ERROR,.PEIEN,.SLIEN,.SLPIEN) Q
.. I $P($G(IBSEG(1)),HLCMP,4)="NM1 2010FA" D PRD^IBTRHLI2(.IBSEG,.RESIEN,.ERROR,.PEIEN,.SLIEN,.SLPIEN) Q
.. I $P($G(IBSEG(1)),HLCMP,4)="PRV 2010FA" Q
. I SEG="CTD",$G(IBSEG(1))="PER 2010EB" D CTD^IBTRHLI3(.IBSEG,.RESIEN,.ERROR,.PEIEN,.SLIEN,.SLPIEN) Q
. I SEG="GT1" Q
. I SEG="PID" Q
. I SEG="PRB" D PRB^IBTRHLI2(.IBSEG,.RESIEN,.ERROR,.SLIEN) Q
. I SEG="AUT" D AUT^IBTRHLI2(.IBSEG,.RESIEN,.ERROR,.SLIEN) Q
. I SEG="ZTP" D ZTP^IBTRHLI3(.IBSEG,.RESIEN,.ERROR,.SLIEN) Q
. I SEG="DG1" D DG1^IBTRHLI3(.IBSEG,.RESIEN,.ERROR,.SLIEN) Q
. I SEG="ZHS" D ZHS^IBTRHLI3(.IBSEG,.RESIEN,.ERROR,.SLIEN) Q
. I SEG="OBR" D OBR^IBTRHLI2(.IBSEG,.RESIEN,.ERROR) Q
. I SEG="RXA" D RXA^IBTRHLI3(.IBSEG,.RESIEN,.ERROR) Q
. I SEG="RXE" D RXE^IBTRHLI3(.IBSEG,.RESIEN,.ERROR) Q
. I SEG="PSL" D PSL^IBTRHLI3(.IBSEG,.RESIEN,.ERROR,.SLIEN) Q
. I SEG="NTE" D NTE^IBTRHLI3(.IBSEG,.RESIEN,.ERROR) Q
. I SEG="NK1" D NK1^IBTRHLI3(.IBSEG,.RESIEN,.ERROR,.PEIEN) Q
; set final status of message
I $G(RESIEN) S IBFDA(356.22,RESIEN_",",.08)=$G(STATUS) K ERROR D FILE^DIE("","IBFDA","ERROR")
I $G(REQIEN) S IBFDA(356.22,REQIEN_",",.08)=$G(STATUS) K ERROR D FILE^DIE("","IBFDA","ERROR")
Q
;
SLCHECK ; check what service line is being processed
I '$G(SLIEN) G SLCHECK1
I $P($G(^IBT(356.22,RESIEN,16,SLIEN,1)),"^")="",$P($G(^(1)),"^",2)="" S LEV1=$G(SLIEN)_","_RESIEN_"," Q
SLCHECK1 ; if not already defined, set new service line entry
S CT=$O(^IBT(356.22,RESIEN,16,"A"),-1)+1
S LEV1="+2,"_RESIEN_","
S IBFDA(356.2216,LEV1,.01)=CT ;SEQ
D UP^IBTRHLI2("SL","2000F") S SLIEN=$G(RIEN(2)) ;SERVICE LINE IEN
S LEV1=SLIEN_","_RESIEN_","
Q
; =================================================================
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRHLI1 3431 printed Apr 09, 2024@21:31:14 Page 2
IBTRHLI1 ;ALB/JWS - Receive and store 278 Response message ;05-JUN-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 ;**Program Description**
+5 ; This program will process incoming HCS REVIEW TRANSMISSION FILE (356.22) ^IBT(356.22).
+6 ; This includes updating the record in the HCSR IIV Response File
+7 ;
+8 ; Variables
+9 ; SEG = HL7 Segment Name
+10 ; RESIEN = Response Record IEN
+11 ; ERROR = processing error condition flag
+12 ; IBSEG = array of segment field data values
EN ; Entry Point
+1 NEW ERROR,HLCMP,HLREP,HLSCMP,RESIEN,SEG,SLIEN,PEIEN,SLPIEN,REQIEN,HCT,IBSEG,BADERROR,STATUS
+2 KILL ^TMP($JOB,"IBTRHLI2")
+3 SET HCT=0
+4 ; HL7 component separator
SET HLCMP=$EXTRACT(HL("ECH"))
+5 ; HL7 subcomponent separator
SET HLSCMP=$EXTRACT(HL("ECH"),4)
+6 ; HL7 repetition separator
SET HLREP=$EXTRACT(HL("ECH"),2)
+7 ; Loop through the message and find each segment for processing
+8 FOR
SET HCT=$ORDER(^TMP($JOB,"IBTRHLI",HCT))
if HCT=""
QUIT
Begin DoDot:1
+9 ; returns all segment fields in IBSEG(field#) array
DO SPAR^IBTRHLU
+10 SET SEG=$GET(IBSEG(0))
+11 IF SEG="MSH"
DO MSH^IBTRHLI2(.IBSEG,.RESIEN,.ERROR)
QUIT
+12 IF SEG="EVN"
QUIT
+13 IF SEG="MSA"
DO MSA^IBTRHLI2(.IBSEG,.RESIEN,.ERROR)
QUIT
+14 IF SEG="IN1"
DO IN1^IBTRHLI2(.IBSEG,.RESIEN,.ERROR)
QUIT
+15 IF SEG="PV1"
DO PV1^IBTRHLI2(.IBSEG,.RESIEN,.ERROR)
QUIT
+16 IF SEG="PRD"
Begin DoDot:2
+17 IF $PIECE($GET(IBSEG(1)),HLCMP,4)="NM1 2010B"
QUIT
+18 IF $PIECE($GET(IBSEG(1)),HLCMP,4)="PRV 2010B"
QUIT
+19 IF $PIECE($GET(IBSEG(1)),HLCMP,4)="NM1 2010EA"
DO PRD^IBTRHLI2(.IBSEG,.RESIEN,.ERROR,.PEIEN,.SLIEN,.SLPIEN)
QUIT
+20 IF $PIECE($GET(IBSEG(1)),HLCMP,4)="PRV 2010EA"
QUIT
+21 IF $PIECE($GET(IBSEG(1)),HLCMP,4)="NM1 2010EC"
DO PRD^IBTRHLI2(.IBSEG,.RESIEN,.ERROR,.PEIEN,.SLIEN,.SLPIEN)
QUIT
+22 IF $PIECE($GET(IBSEG(1)),HLCMP,4)="NM1 2010FA"
DO PRD^IBTRHLI2(.IBSEG,.RESIEN,.ERROR,.PEIEN,.SLIEN,.SLPIEN)
QUIT
+23 IF $PIECE($GET(IBSEG(1)),HLCMP,4)="PRV 2010FA"
QUIT
End DoDot:2
QUIT
+24 IF SEG="CTD"
IF $GET(IBSEG(1))="PER 2010EB"
DO CTD^IBTRHLI3(.IBSEG,.RESIEN,.ERROR,.PEIEN,.SLIEN,.SLPIEN)
QUIT
+25 IF SEG="GT1"
QUIT
+26 IF SEG="PID"
QUIT
+27 IF SEG="PRB"
DO PRB^IBTRHLI2(.IBSEG,.RESIEN,.ERROR,.SLIEN)
QUIT
+28 IF SEG="AUT"
DO AUT^IBTRHLI2(.IBSEG,.RESIEN,.ERROR,.SLIEN)
QUIT
+29 IF SEG="ZTP"
DO ZTP^IBTRHLI3(.IBSEG,.RESIEN,.ERROR,.SLIEN)
QUIT
+30 IF SEG="DG1"
DO DG1^IBTRHLI3(.IBSEG,.RESIEN,.ERROR,.SLIEN)
QUIT
+31 IF SEG="ZHS"
DO ZHS^IBTRHLI3(.IBSEG,.RESIEN,.ERROR,.SLIEN)
QUIT
+32 IF SEG="OBR"
DO OBR^IBTRHLI2(.IBSEG,.RESIEN,.ERROR)
QUIT
+33 IF SEG="RXA"
DO RXA^IBTRHLI3(.IBSEG,.RESIEN,.ERROR)
QUIT
+34 IF SEG="RXE"
DO RXE^IBTRHLI3(.IBSEG,.RESIEN,.ERROR)
QUIT
+35 IF SEG="PSL"
DO PSL^IBTRHLI3(.IBSEG,.RESIEN,.ERROR,.SLIEN)
QUIT
+36 IF SEG="NTE"
DO NTE^IBTRHLI3(.IBSEG,.RESIEN,.ERROR)
QUIT
+37 IF SEG="NK1"
DO NK1^IBTRHLI3(.IBSEG,.RESIEN,.ERROR,.PEIEN)
QUIT
End DoDot:1
if $DATA(BADERROR)
QUIT
+38 ; set final status of message
+39 IF $GET(RESIEN)
SET IBFDA(356.22,RESIEN_",",.08)=$GET(STATUS)
KILL ERROR
DO FILE^DIE("","IBFDA","ERROR")
+40 IF $GET(REQIEN)
SET IBFDA(356.22,REQIEN_",",.08)=$GET(STATUS)
KILL ERROR
DO FILE^DIE("","IBFDA","ERROR")
+41 QUIT
+42 ;
SLCHECK ; check what service line is being processed
+1 IF '$GET(SLIEN)
GOTO SLCHECK1
+2 IF $PIECE($GET(^IBT(356.22,RESIEN,16,SLIEN,1)),"^")=""
IF $PIECE($GET(^(1)),"^",2)=""
SET LEV1=$GET(SLIEN)_","_RESIEN_","
QUIT
SLCHECK1 ; if not already defined, set new service line entry
+1 SET CT=$ORDER(^IBT(356.22,RESIEN,16,"A"),-1)+1
+2 SET LEV1="+2,"_RESIEN_","
+3 ;SEQ
SET IBFDA(356.2216,LEV1,.01)=CT
+4 ;SERVICE LINE IEN
DO UP^IBTRHLI2("SL","2000F")
SET SLIEN=$GET(RIEN(2))
+5 SET LEV1=SLIEN_","_RESIEN_","
+6 QUIT
+7 ; =================================================================
