IBTRHLO2 ;ALB/YMG - Create and send 278 inquiry cont. ;02-JUN-2014
;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
HLSC(IEN,TSTAMP,HLRESLT) ; update entry in 356.22 on successful creation of HL7 message
; called from EN^IBTRHLO
; IEN - file 356.22 ien
; TSTAMP - timestamp of message creation
; HLRESLT - return value of GENERATE^HLMA() API call
;
N IBTRFDA,IENS,MSGID
S MSGID=$P(HLRESLT,U)
S IENS=IEN_","
S IBTRFDA(356.22,IENS,.08)="02"
S IBTRFDA(356.22,IENS,.12)=MSGID
S IBTRFDA(356.22,IENS,.15)=TSTAMP
D FILE^DIE(,"IBTRFDA")
D CLEAN^DILF
Q
;
HLER(IEN,ERRMSG) ; process error on failure to create HL7 message
; called from EN^IBTRHLO
; IEN - file 356.22 ien
; ERRMSG - error message string
;
N IBTRFDA,IENS
S IENS=IEN_","
S IBTRFDA(356.22,IENS,.08)="03"
D FILE^DIE(,"IBTRFDA")
K IBTRFDA
S IENS="?+1,"_IEN_","
S IBTRFDA(356.22101,IENS,.01)=1
S IBTRFDA(356.22101,IENS,1)=$E(ERRMSG,1,250)
D UPDATE^DIE(,"IBTRFDA")
D CLEAN^DILF
Q
;
WP2STR(FILE,FIELD,IENS,LEN) ; convert word-processing field into a single string
; FILE - file #
; FIELD - WP field #
; IENS - ien string of entry to process, including trailing comma
; LEN - maximum length of the output string (if not specified - unlimited length)
;
; returns string containing data from specified WP field
;
N DATA,STOPFLG,STR,STRLEN,Z
S STR="",LEN=+$G(LEN),STOPFLG=0
I $G(FILE),$G(FIELD),$G(IENS) D
.S Z=$$GET1^DIQ(FILE,IENS,FIELD,,"DATA")
.S Z="" F S Z=$O(DATA(Z)) Q:Z=""!STOPFLG D
..S:STR'="" STR=STR_" "
..S STRLEN=$L(STR)+$L(DATA(Z)) I LEN,STRLEN>LEN S STOPFLG=1
..S STR=STR_$S('LEN:DATA(Z),STRLEN'>LEN:DATA(Z),1:$E(DATA(Z),1,LEN-$L(STR)))
..Q
.Q
Q STR
;
PRVDATA(IEN,FILE) ; get provider data
; IEN - ien for the entry
; FILE - file number IEN is for
;
; returns the following string:
; name ^ address line 1 ^ address line 2 ^ city ^ state (file 5 ien) ^ zip ^ NPI
;
N DATA,IENS,NPI,RES,Z
S RES=""
I $G(IEN),$G(FILE) D
.S IENS=IEN_","
.I FILE=4 D ; pointer to file 4
..D GETS^DIQ(FILE,IENS,".01;4.01:4.05;100","IE","DATA")
..S NPI=$P($$NPI^XUSNPI("Organization_ID",IEN),U) S:NPI<1 NPI=""
..S RES=$G(DATA(FILE,IENS,100,"E")) I RES="" S RES=$G(DATA(FILE,IENS,.01,"E"))
..S RES=RES_U_$G(DATA(FILE,IENS,4.01,"E"))_U_$G(DATA(FILE,IENS,4.02,"E"))_U_$G(DATA(FILE,IENS,4.03,"E"))
..S RES=RES_U_$G(DATA(FILE,IENS,4.04,"I"))_U_$G(DATA(FILE,IENS,4.05,"E"))_U_NPI
..Q
.I FILE=200 D ; pointer to file 200
..D GETS^DIQ(FILE,IENS,".01;.111:.116","IE","DATA")
..S NPI=$P($$NPI^XUSNPI("Individual_ID",IEN),U) S:NPI<1 NPI=""
..S RES=$G(DATA(FILE,IENS,.01,"E"))_U_$G(DATA(FILE,IENS,.111,"E"))
..S Z=$G(DATA(FILE,IENS,.113,"E")) ; addr. line 3
..S RES=RES_U_$G(DATA(FILE,IENS,.112,"E"))_$S(Z'="":" "_Z,1:"")_U_$G(DATA(FILE,IENS,.114,"E"))
..S RES=RES_U_$G(DATA(FILE,IENS,.115,"I"))_U_$TR($G(DATA(FILE,IENS,.116,"E")),"-")_U_NPI
..Q
.I FILE=355.93 D ; pointer to file 355.93
..D GETS^DIQ(FILE,IENS,".01;.05:.08;.1","IE","DATA")
..S NPI=$$NPIGET^IBCEP81(IEN)
..S RES=$G(DATA(FILE,IENS,.01,"E"))_U_$G(DATA(FILE,IENS,.05,"E"))_U_$G(DATA(FILE,IENS,.1,"E"))
..S RES=RES_U_$G(DATA(FILE,IENS,.06,"E"))_U_$G(DATA(FILE,IENS,.07,"I"))_U_$TR($G(DATA(FILE,IENS,.08,"E")),"-")_U_NPI
..Q
.Q
; check address integrity, line 1 and city are required
; if either is missing, don't return any of the address fields
I $P(RES,U,2)=""!($P(RES,U,4)="") S $P(RES,U,2,6)="^^^^"
Q RES
;
PCODECNV(CODE) ; provider code conversion between NM1 and PRV X12 segments
; CODE - code to convert
; returns converted code (NM1 -> PRV), or null if no match found
N I,NM1STR,PRVSTR,RES
S NM1STR="71^72^73^AAJ^DD^DK^DN^P3^SJ"
S PRVSTR="AT^OP^OT^AD^AS^OR^RF^PC^PE"
S RES=""
F I=1:1:9 S:$P(NM1STR,U,I)=CODE RES=$P(PRVSTR,U,I) Q:RES'=""
Q RES
;
NTE ; create NTE segment
N MSG,NTE
S MSG=$$WP2STR(356.22,12,IBTRIEN_",",264)
I MSG="" Q
S NTE="NTE"_HLFS_HLFS_HLFS_$$ENCHL7^IBCNEHLQ(MSG)_HLFS_"MSG 2000E"
S HCT=HCT+1,^TMP("HLS",$J,HCT)=NTE
Q
;
ZHS ; create ZHS segment
N QUAL,VALUE,ZHS
S ZHS="ZHS"_HLFS_"HSD 2000E" ;ZHS.1 = LOOP ID
S QUAL=$$GET1^DIQ(365.016,+$P(NODE4,U)_",",.01)
S VALUE=$P(NODE4,U,2)
I QUAL'="",VALUE'="" S $P(ZHS,HLFS,3)=QUAL,$P(ZHS,HLFS,4)=VALUE ;ZHS.2=4.01, ZHS.3=4.02
S QUAL=$P(NODE4,U,3)
S VALUE=$P(NODE4,U,4)
I QUAL'="",VALUE'="" S $P(ZHS,HLFS,5)=QUAL ;ZHS.4=4.03
I VALUE'="" S $P(ZHS,HLFS,6)=VALUE ;ZHS.5=4.04
S QUAL=$$GET1^DIQ(365.015,+$P(NODE4,U,5)_",",.01)
S VALUE=$P(NODE4,U,6)
I QUAL'="",VALUE'="" S $P(ZHS,HLFS,7)=QUAL,$P(ZHS,HLFS,8)=VALUE ;ZHS.6=4.05, ZHS.7=4.06
S $P(ZHS,HLFS,9)=$$GET1^DIQ(365.025,+$P(NODE4,U,7)_",",.01) ;ZHS.8=4.07
S $P(ZHS,HLFS,10)=$$GET1^DIQ(356.007,+$P(NODE4,U,8)_",",.01) ;ZHS.9=4.08
I $TR($P(ZHS,HLFS,3,99),HLFS)="" Q
S HCT=HCT+1,^TMP("HLS",$J,HCT)=ZHS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRHLO2 4941 printed Apr 09, 2024@21:19:05 Page 2
IBTRHLO2 ;ALB/YMG - Create and send 278 inquiry cont. ;02-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 QUIT
+5 ;
HLSC(IEN,TSTAMP,HLRESLT) ; update entry in 356.22 on successful creation of HL7 message
+1 ; called from EN^IBTRHLO
+2 ; IEN - file 356.22 ien
+3 ; TSTAMP - timestamp of message creation
+4 ; HLRESLT - return value of GENERATE^HLMA() API call
+5 ;
+6 NEW IBTRFDA,IENS,MSGID
+7 SET MSGID=$PIECE(HLRESLT,U)
+8 SET IENS=IEN_","
+9 SET IBTRFDA(356.22,IENS,.08)="02"
+10 SET IBTRFDA(356.22,IENS,.12)=MSGID
+11 SET IBTRFDA(356.22,IENS,.15)=TSTAMP
+12 DO FILE^DIE(,"IBTRFDA")
+13 DO CLEAN^DILF
+14 QUIT
+15 ;
HLER(IEN,ERRMSG) ; process error on failure to create HL7 message
+1 ; called from EN^IBTRHLO
+2 ; IEN - file 356.22 ien
+3 ; ERRMSG - error message string
+4 ;
+5 NEW IBTRFDA,IENS
+6 SET IENS=IEN_","
+7 SET IBTRFDA(356.22,IENS,.08)="03"
+8 DO FILE^DIE(,"IBTRFDA")
+9 KILL IBTRFDA
+10 SET IENS="?+1,"_IEN_","
+11 SET IBTRFDA(356.22101,IENS,.01)=1
+12 SET IBTRFDA(356.22101,IENS,1)=$EXTRACT(ERRMSG,1,250)
+13 DO UPDATE^DIE(,"IBTRFDA")
+14 DO CLEAN^DILF
+15 QUIT
+16 ;
WP2STR(FILE,FIELD,IENS,LEN) ; convert word-processing field into a single string
+1 ; FILE - file #
+2 ; FIELD - WP field #
+3 ; IENS - ien string of entry to process, including trailing comma
+4 ; LEN - maximum length of the output string (if not specified - unlimited length)
+5 ;
+6 ; returns string containing data from specified WP field
+7 ;
+8 NEW DATA,STOPFLG,STR,STRLEN,Z
+9 SET STR=""
SET LEN=+$GET(LEN)
SET STOPFLG=0
+10 IF $GET(FILE)
IF $GET(FIELD)
IF $GET(IENS)
Begin DoDot:1
+11 SET Z=$$GET1^DIQ(FILE,IENS,FIELD,,"DATA")
+12 SET Z=""
FOR
SET Z=$ORDER(DATA(Z))
if Z=""!STOPFLG
QUIT
Begin DoDot:2
+13 if STR'=""
SET STR=STR_" "
+14 SET STRLEN=$LENGTH(STR)+$LENGTH(DATA(Z))
IF LEN
IF STRLEN>LEN
SET STOPFLG=1
+15 SET STR=STR_$SELECT('LEN:DATA(Z),STRLEN'>LEN:DATA(Z),1:$EXTRACT(DATA(Z),1,LEN-$LENGTH(STR)))
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 QUIT STR
+19 ;
PRVDATA(IEN,FILE) ; get provider data
+1 ; IEN - ien for the entry
+2 ; FILE - file number IEN is for
+3 ;
+4 ; returns the following string:
+5 ; name ^ address line 1 ^ address line 2 ^ city ^ state (file 5 ien) ^ zip ^ NPI
+6 ;
+7 NEW DATA,IENS,NPI,RES,Z
+8 SET RES=""
+9 IF $GET(IEN)
IF $GET(FILE)
Begin DoDot:1
+10 SET IENS=IEN_","
+11 ; pointer to file 4
IF FILE=4
Begin DoDot:2
+12 DO GETS^DIQ(FILE,IENS,".01;4.01:4.05;100","IE","DATA")
+13 SET NPI=$PIECE($$NPI^XUSNPI("Organization_ID",IEN),U)
if NPI<1
SET NPI=""
+14 SET RES=$GET(DATA(FILE,IENS,100,"E"))
IF RES=""
SET RES=$GET(DATA(FILE,IENS,.01,"E"))
+15 SET RES=RES_U_$GET(DATA(FILE,IENS,4.01,"E"))_U_$GET(DATA(FILE,IENS,4.02,"E"))_U_$GET(DATA(FILE,IENS,4.03,"E"))
+16 SET RES=RES_U_$GET(DATA(FILE,IENS,4.04,"I"))_U_$GET(DATA(FILE,IENS,4.05,"E"))_U_NPI
+17 QUIT
End DoDot:2
+18 ; pointer to file 200
IF FILE=200
Begin DoDot:2
+19 DO GETS^DIQ(FILE,IENS,".01;.111:.116","IE","DATA")
+20 SET NPI=$PIECE($$NPI^XUSNPI("Individual_ID",IEN),U)
if NPI<1
SET NPI=""
+21 SET RES=$GET(DATA(FILE,IENS,.01,"E"))_U_$GET(DATA(FILE,IENS,.111,"E"))
+22 ; addr. line 3
SET Z=$GET(DATA(FILE,IENS,.113,"E"))
+23 SET RES=RES_U_$GET(DATA(FILE,IENS,.112,"E"))_$SELECT(Z'="":" "_Z,1:"")_U_$GET(DATA(FILE,IENS,.114,"E"))
+24 SET RES=RES_U_$GET(DATA(FILE,IENS,.115,"I"))_U_$TRANSLATE($GET(DATA(FILE,IENS,.116,"E")),"-")_U_NPI
+25 QUIT
End DoDot:2
+26 ; pointer to file 355.93
IF FILE=355.93
Begin DoDot:2
+27 DO GETS^DIQ(FILE,IENS,".01;.05:.08;.1","IE","DATA")
+28 SET NPI=$$NPIGET^IBCEP81(IEN)
+29 SET RES=$GET(DATA(FILE,IENS,.01,"E"))_U_$GET(DATA(FILE,IENS,.05,"E"))_U_$GET(DATA(FILE,IENS,.1,"E"))
+30 SET RES=RES_U_$GET(DATA(FILE,IENS,.06,"E"))_U_$GET(DATA(FILE,IENS,.07,"I"))_U_$TRANSLATE($GET(DATA(FILE,IENS,.08,"E")),"-")_U_NPI
+31 QUIT
End DoDot:2
+32 QUIT
End DoDot:1
+33 ; check address integrity, line 1 and city are required
+34 ; if either is missing, don't return any of the address fields
+35 IF $PIECE(RES,U,2)=""!($PIECE(RES,U,4)="")
SET $PIECE(RES,U,2,6)="^^^^"
+36 QUIT RES
+37 ;
PCODECNV(CODE) ; provider code conversion between NM1 and PRV X12 segments
+1 ; CODE - code to convert
+2 ; returns converted code (NM1 -> PRV), or null if no match found
+3 NEW I,NM1STR,PRVSTR,RES
+4 SET NM1STR="71^72^73^AAJ^DD^DK^DN^P3^SJ"
+5 SET PRVSTR="AT^OP^OT^AD^AS^OR^RF^PC^PE"
+6 SET RES=""
+7 FOR I=1:1:9
if $PIECE(NM1STR,U,I)=CODE
SET RES=$PIECE(PRVSTR,U,I)
if RES'=""
QUIT
+8 QUIT RES
+9 ;
NTE ; create NTE segment
+1 NEW MSG,NTE
+2 SET MSG=$$WP2STR(356.22,12,IBTRIEN_",",264)
+3 IF MSG=""
QUIT
+4 SET NTE="NTE"_HLFS_HLFS_HLFS_$$ENCHL7^IBCNEHLQ(MSG)_HLFS_"MSG 2000E"
+5 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=NTE
+6 QUIT
+7 ;
ZHS ; create ZHS segment
+1 NEW QUAL,VALUE,ZHS
+2 ;ZHS.1 = LOOP ID
SET ZHS="ZHS"_HLFS_"HSD 2000E"
+3 SET QUAL=$$GET1^DIQ(365.016,+$PIECE(NODE4,U)_",",.01)
+4 SET VALUE=$PIECE(NODE4,U,2)
+5 ;ZHS.2=4.01, ZHS.3=4.02
IF QUAL'=""
IF VALUE'=""
SET $PIECE(ZHS,HLFS,3)=QUAL
SET $PIECE(ZHS,HLFS,4)=VALUE
+6 SET QUAL=$PIECE(NODE4,U,3)
+7 SET VALUE=$PIECE(NODE4,U,4)
+8 ;ZHS.4=4.03
IF QUAL'=""
IF VALUE'=""
SET $PIECE(ZHS,HLFS,5)=QUAL
+9 ;ZHS.5=4.04
IF VALUE'=""
SET $PIECE(ZHS,HLFS,6)=VALUE
+10 SET QUAL=$$GET1^DIQ(365.015,+$PIECE(NODE4,U,5)_",",.01)
+11 SET VALUE=$PIECE(NODE4,U,6)
+12 ;ZHS.6=4.05, ZHS.7=4.06
IF QUAL'=""
IF VALUE'=""
SET $PIECE(ZHS,HLFS,7)=QUAL
SET $PIECE(ZHS,HLFS,8)=VALUE
+13 ;ZHS.8=4.07
SET $PIECE(ZHS,HLFS,9)=$$GET1^DIQ(365.025,+$PIECE(NODE4,U,7)_",",.01)
+14 ;ZHS.9=4.08
SET $PIECE(ZHS,HLFS,10)=$$GET1^DIQ(356.007,+$PIECE(NODE4,U,8)_",",.01)
+15 IF $TRANSLATE($PIECE(ZHS,HLFS,3,99),HLFS)=""
QUIT
+16 SET HCT=HCT+1
SET ^TMP("HLS",$JOB,HCT)=ZHS
+17 QUIT
