IBTRH2A ;ALB/YMG - HCSR worklist expand entry cont. ;18-JUN-2014
;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
LOCKERR ; display a lock error message
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W *7,!!,"Some else is editing the event. Try again later."
S DIR(0)="EA",DIR("A")="Press RETURN to continue " D ^DIR
Q
;
COPYERR(TYPE) ; display the error encountered while copying a request
; TYPE = 0 - error while reading data, TYPE = 1 - error while filing data
; ERROR - array used for FM error reporting, populated in the calling tag
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,STR,X,Y,Z,Z1
I $D(ERROR) D
.W !,"Unable to copy - the following error was encountered while "
.W $S(TYPE:"filing",1:"retrieving")," the data:"
.S Z=0 F S Z=$O(ERROR("DIERR",Z)) Q:'Z D
..S STR=$G(ERROR("DIERR",Z)) I STR'="" W !,"Error code: "_STR
..S STR=$G(ERROR("DIERR",Z,"PARAM","FILE")) I STR'="" W !,"File number: "_STR
..S STR=$G(ERROR("DIERR",Z,"PARAM","FIELD")) I STR'="" W !,"Field number: "_STR
..W !,"Error text:" S Z1=0 F S Z1=$O(ERROR("DIERR",1,"TEXT",Z1)) Q:'Z1 W !,ERROR("DIERR",1,"TEXT",Z1)
..Q
.S DIR(0)="EA",DIR("A")="Press RETURN to continue " D ^DIR
.Q
Q
;
MLTCPY(SFNUM,NEWIENS) ; copy a multiple
; SFNUM - sub-file number of a multiple to copy
; NEWIENS - iens of a new entry (copied to)
; OLDENTRY - FDA array to get data from (defined in the calling tag)
;
; returns 1 on successful copy, 0 on failure
;
N ERROR,NEWENTRY,RES,STOPFLG,Z
S RES=1,STOPFLG=0
S Z=0 F S Z=$O(OLDENTRY(SFNUM,Z)) Q:'Z D Q:STOPFLG
.K NEWENTRY D FDACPY(SFNUM,Z,"+1,"_NEWIENS,.OLDENTRY,.NEWENTRY)
.D UPDATE^DIE(,"NEWENTRY",,"ERROR")
.I $D(ERROR) D COPYERR(1) S STOPFLG=1,RES=0
.Q
Q RES
;
FDACPY(FN,OLDIENS,NEWIENS,OLDENTRY,NEWENTRY) ; copy FDA array, move data from "I" nodes to regular ones
; FN - file or subfile #
; OLDIENS - IENS for the OLDENTRY array
; NEWIENS - IENS for the NEWENTRY array
; OLDENTRY - array to copy from (passed by reference)
; NEWENTRY - array to copy into (passed by reference)
;
N FLD,VALUE
S FLD="" F S FLD=$O(OLDENTRY(FN,OLDIENS,FLD)) Q:FLD="" D
.S VALUE=$G(OLDENTRY(FN,OLDIENS,FLD,"I"))
.I VALUE'="" S NEWENTRY(FN,NEWIENS,FLD)=VALUE
.Q
Q
;
MLTCLEAR(IBTRIEN) ; delete entries from multiples in file 356.22
; IBTRIEN - file 356.22 ien
N DA,DIK,FLD,Z
I +$G(IBTRIEN)'>0 Q
F FLD=3,11,13,14,15,16 D
.S DIK="^IBT(356.22,"_IBTRIEN_","_FLD_",",DA(1)=IBTRIEN
.S DA=0 F S DA=$O(^IBT(356.22,IBTRIEN,FLD,DA)) Q:'DA!(DA?1.A) D ^DIK
.Q
Q
;
ADDR(FILE,IEN,LN1FLD,LN2FLD,LN3FLD,CITFLD,STFLD,ZIPFLD,RES) ; format address for output
; FILE - file number to get address from
; IEN - ien in FILE
; LN1FLD - field # for addr. line 1
; LN2FLD - field # for addr. line 2
; LN3FLD - field # for addr. line 3
; CITFLD - field # for city
; STFLD - field # for state
; ZIPFLD - field # for zip
; RES - array of formatted address lines this function returns
;
N ADDRDATA,DRSTR,CNT,CSSTR,IENS,LN1STR,LN2STR,LN3STR,STATE,TMP,Z,Z1,Z2,ZIP
K RES S RES(1)=""
S IENS=IEN_","
S DRSTR=LN1FLD_";"_LN2FLD_";"_LN3FLD_";"_CITFLD_";"_STFLD_";"_ZIPFLD
D GETS^DIQ(FILE,IENS,DRSTR,"EI","ADDRDATA")
S CSSTR=$G(ADDRDATA(FILE,IENS,CITFLD,"E"))
S STATE=$$GET1^DIQ(5,$G(ADDRDATA(FILE,IENS,STFLD,"I"))_",",1)
S ZIP=$G(ADDRDATA(FILE,IENS,ZIPFLD,"E"))
S TMP=$E(ZIP,6,9),ZIP=$E(ZIP,1,5)_$S(TMP'="":"-"_TMP,1:"")
S STATE=STATE_$S(STATE=""!(ZIP=""):"",1:" ")_ZIP
S CSSTR=CSSTR_$S(CSSTR=""!(STATE=""):"",1:", ")_STATE
S LN1STR=$G(ADDRDATA(FILE,IENS,LN1FLD,"E")),LN2STR=$G(ADDRDATA(FILE,IENS,LN2FLD,"E")),LN3STR=$G(ADDRDATA(FILE,IENS,LN3FLD,"E"))
S CNT=1 F Z=LN1STR,LN2STR,LN3STR,CSSTR I Z'="" S Z1=$G(RES(CNT)),Z2=", " D
.S:Z1="" Z2="" S:($L(Z1)+2+$L(Z))>64 Z2="",CNT=CNT+1 S RES(CNT)=$G(RES(CNT))_Z2_Z
.Q
Q
;
STATMSG(TYPE) ; display transmission status message
; TYPE - 1 if transmission successful, 0 otherwise
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="EA"
S DIR("A",1)=" "
I TYPE=0 S DIR("A",2)="278 request has been sent successfully."
I TYPE=1 S DIR("A",2)="Unable to send 278 request, can't find an entry in file 356.22."
I TYPE=2 S DIR("A",2)="Unable to send 278 request, check HCSR worklist entry for errors."
I TYPE=3 S DIR("A",2)="Unable to send 278 request, there's already a 278 request awaiting a response."
I TYPE=4 S DIR("A",2)="This 278 request has a pending response from the payer. Please use SI action to send Inquiry if needed."
S DIR("A")="Press RETURN to continue " D ^DIR
Q
;
MSG215(TYPE,TTYPE) ; display transmission status message
; TYPE - 1 if transmission successful, 0 otherwise
; TTYPE - 'C' for 278x215 cancel transaction
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="EA"
S DIR("A",1)=" "
I TYPE=0 S DIR("A",2)="278 "_$S($G(TTYPE)="C":"Cancellation",1:"Inquiry")_" has been sent successfully."
I TYPE=1 S DIR("A",2)="Unable to send 278 Inquiry, can't find an entry in file 356.22."
I TYPE=2 S DIR("A",2)="Unable to send 278 "_$S($G(TTYPE)="C":"Cancellation",1:"Inquiry")_", check HCSR worklist entry for errors."
I TYPE=3 S DIR("A",2)="Unable to send 278 Inquiry, HCSR worklist entry is NOT in a 'Pending' status."
I TYPE=4 S DIR("A",2)="Unable to generate 278 Inquiry, copy of existing entry failed"
I TYPE=5 S DIR("A",2)="278x215 Inquiry has already been generated for this HCSR worklist entry."
S DIR("A")="Press RETURN to continue " D ^DIR
Q
;
COPY278 ; copy 278 request
; requires IBTRIEN to be defined and contain ien of the 356.22 entry being copied
;
N COB,COBSTR,CURCOB,DFN,DIR,DIROUT,DIRUT,DTOUT,DUOUT,ERROR,EVENTDT,IEN312,IENARRY,IENS,INSNODE0,INSDATA,LIST,NODE0
N NEWENTRY,NIENS,NIENS16,OLDENTRY,OLDWP,SAVEIEN,STOPFLG,TMP,X,Y,Z,Z1,IBRESP,IBTRENT,NEWIEN,PAYIEN,STOP
S VALMBCK="R"
I +$G(IBTRIEN)'>0 Q
S NODE0=$G(^IBT(356.22,IBTRIEN,0))
S DFN=+$P(NODE0,U,2),IEN312=+$P(NODE0,U,3)
S INSNODE0="" S:IEN312>0 INSNODE0=$G(^DPT(DFN,.312,IEN312,0)) ; 0-node in file 2.312
S CURCOB=$P(INSNODE0,U,20) ; COB for the 356.22 entry we're working on
S EVENTDT=$P(NODE0,U,7)
; build a list of existing entries for this patient and event date
S Z="" F S Z=$O(^IBT(356.22,"D",DFN,EVENTDT,Z)) Q:'Z D
.S NODE0=$G(^IBT(356.22,Z,0))
.I +$P(NODE0,U,13)>0 Q ; inquiry pointer exists - this is a response entry
.S IEN312=+$P(NODE0,U,3) I IEN312>0,$G(LIST(IEN312))="" S LIST(IEN312)=Z_U_$$STATUS^IBTRH2(Z)
.Q
D ALL^IBCNS1(DFN,"INSDATA",1,$P(EVENTDT,"-"),1)
I INSDATA(0)<2 D MSG(1) Q ; need at least 2 insurance policies to be available
S STOPFLG=0
F COB=1:1:3 S IEN312=$O(INSDATA("S",COB,"")) I IEN312'="",COB'=CURCOB D Q:STOPFLG
.S PAYIEN=$P($G(^DPT(DFN,.312,IEN312,0)),"^") I PAYIEN="" S STOPFLG=1 Q
.I '$D(^IBE(350.9,1,$S($P(NODE0,"^",4):66,1:65),"B",PAYIEN)) S STOP=2 Q
.I +$P($G(LIST(IEN312)),U,2)>1 S STOP=3 Q ; already sent request for this entry
.S COBSTR=$S(COB=1:"primary",COB=2:"secondary",1:"tertiary")
.S DIR("A")="Copy 278 request to "_COBSTR_" insurance? (Y/N): ",DIR("B")="Y",DIR(0)="YAO" D ^DIR K DIR
.I $G(DTOUT)!$G(DUOUT)!$G(DIROUT)!($G(Y)'=1) Q
.; copy the entry in 356.22
.S STOP=4
.S IENS=IBTRIEN_","
.D GETS^DIQ(356.22,IENS,".02;.04:.07;.16;2.01:2.25;3*;4.01:4.14;5.01:5.18;6.01:6.18;7.01:7.13;8.01:8.08;9.01:9.08;10.01:10.13;11*;14*;15*;18.01:18.1","IN","OLDENTRY","ERROR")
.I $D(ERROR) D COPYERR(0) S STOPFLG=1 Q
.S NIENS=+$G(LIST(IEN312))_"," ; iens of the new entry in 356.22 (top level)
.I NIENS="0," S NIENS="+1,",NEWENTRY(356.22,NIENS,.01)=$$NOW^XLFDT()
.D FDACPY(356.22,IENS,NIENS,.OLDENTRY,.NEWENTRY)
.S NEWENTRY(356.22,NIENS,.03)=IEN312
.S NEWENTRY(356.22,NIENS,.11)=DUZ
.; WP field 356.22/12
.D GETS^DIQ(356.22,IENS,"12","N","OLDWP","ERROR") I $D(ERROR) D COPYERR(0) S STOPFLG=1 Q
.M NEWENTRY(356.22,NIENS,12)=OLDWP(356.22,IENS,12)
.I NIENS="+1," D UPDATE^DIE(,"NEWENTRY","NEWIEN","ERROR")
.I NIENS'="+1," D FILE^DIE(,"NEWENTRY","ERROR")
.I $D(ERROR) D COPYERR(1) S STOPFLG=1 Q
.I $D(NEWIEN(1)) S NIENS=NEWIEN(1)_",",LIST(IEN312)=NEWIEN(1)
.D MLTCLEAR($P(NIENS,","))
.; multiple 356.223
.I '$$MLTCPY(356.223,NIENS) S STOPFLG=1 Q
.; multiple 356.2211
.I '$$MLTCPY(356.2211,NIENS) S STOPFLG=1 Q
.; multiple 356.2214
.I '$$MLTCPY(356.2214,NIENS) S STOPFLG=1 Q
.; multiple 356.2215
.I '$$MLTCPY(356.2215,NIENS) S STOPFLG=1 Q
.; multiple 356.2213 - not all fields are being copied, each entry needs to be handled separately
.S Z=0 F S Z=$O(^IBT(356.22,IBTRIEN,13,Z)) Q:'Z D Q:STOPFLG
..S IENS=Z_","_IBTRIEN_"," K NEWENTRY,OLDENTRY
..D GETS^DIQ(356.2213,IENS,".01:.03","IN","OLDENTRY","ERROR")
..I $D(ERROR) D COPYERR(0) S STOPFLG=1 Q
..D FDACPY(356.2213,IENS,"+1,"_NIENS,.OLDENTRY,.NEWENTRY)
..D UPDATE^DIE(,"NEWENTRY",,"ERROR")
..I $D(ERROR) D COPYERR(1) S STOPFLG=1
..Q
.; multiple 356.2216 - not all fields are being copied, each entry needs to be handled separately
.S Z=0 F S Z=$O(^IBT(356.22,IBTRIEN,16,Z)) Q:'Z D Q:STOPFLG
..S IENS=Z_","_IBTRIEN_"," K OLDENTRY
..D GETS^DIQ(356.2216,IENS,".01:.14;1.01:1.12;2.01:2.09;3.01:3.07;4*;5.01:5.08;6*","IN","OLDENTRY","ERROR")
..I $D(ERROR) D COPYERR(0) S STOPFLG=1 Q
..K NEWENTRY D FDACPY(356.2216,IENS,"+1,"_NIENS,.OLDENTRY,.NEWENTRY)
..; WP field 356.2216/7
..K OLDWP D GETS^DIQ(356.2216,IENS,"7","N","OLDWP","ERROR") I $D(ERROR) D COPYERR(0) S STOPFLG=1 Q
..M NEWENTRY(356.2216,"+1,"_NIENS,7)=OLDWP(356.2216,IENS,7)
..K IENARRY D UPDATE^DIE(,"NEWENTRY","IENARRY","ERROR")
..I $D(ERROR) D COPYERR(1) S STOPFLG=1 Q
..S NIENS16=IENARRY(1)_","_NIENS ; iens of the new entry in 356.2216
..; multiple 356.22164
..I '$$MLTCPY(356.22164,NIENS16) S STOPFLG=1 Q
..; multiple 356.22166
..I '$$MLTCPY(356.22166,NIENS16) S STOPFLG=1 Q
..; multiple 356.22167
..I '$$MLTCPY(356.22166,NIENS16) S STOPFLG=1 Q
..; multiple 356.22168 - not all fields are being copied, each entry needs to be handled separately
..S Z1=0 F S Z1=$O(^IBT(356.22,IBTRIEN,16,Z,8,Z1)) Q:'Z1 D Q:STOPFLG
...S IENS=Z1_","_Z_","_IBTRIEN_"," K NEWENTRY,OLDENTRY
...D GETS^DIQ(356.22168,IENS,".01:.03","IN","OLDENTRY","ERROR")
...I $D(ERROR) D COPYERR(0) S STOPFLG=1 Q
...D FDACPY(356.22168,IENS,"+1,"_NIENS16,.OLDENTRY,.NEWENTRY)
...D UPDATE^DIE(,"NEWENTRY",,"ERROR")
...I $D(ERROR) D COPYERR(1) S STOPFLG=1
...Q
..Q
.; ask if new 278 request should be sent right away
.S SAVEIEN=IBTRIEN,IBTRIEN=+$G(LIST(IEN312)),IBTRENT=0 D SEND278^IBTRH2 S IBTRIEN=SAVEIEN
.Q
I +$G(STOP)>0,+$G(STOP)<4 D MSG(STOP)
Q
;
MSG(TYPE) ;display status message
; TYPE = 1 No alternate insurance available for this patient
; = 2 alternate insurance not setup for 278 submission
; = 3 278 already created for alternate insurance
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="EA"
S DIR("A",1)=" "
I TYPE=1 S DIR("A",2)="No alternate insurance available for this patient."
I TYPE=2 S DIR("A",2)="Alternate insurance is not enabled for 278 submission."
I TYPE=3 S DIR("A",2)="A 278 is already submitted for the alternate insurance."
S DIR("A")="Press RETURN to continue " D ^DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRH2A 11202 printed Apr 09, 2024@21:09:05 Page 2
IBTRH2A ;ALB/YMG - HCSR worklist expand entry cont. ;18-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 ;
LOCKERR ; display a lock error message
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE *7,!!,"Some else is editing the event. Try again later."
+3 SET DIR(0)="EA"
SET DIR("A")="Press RETURN to continue "
DO ^DIR
+4 QUIT
+5 ;
COPYERR(TYPE) ; display the error encountered while copying a request
+1 ; TYPE = 0 - error while reading data, TYPE = 1 - error while filing data
+2 ; ERROR - array used for FM error reporting, populated in the calling tag
+3 ;
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,STR,X,Y,Z,Z1
+5 IF $DATA(ERROR)
Begin DoDot:1
+6 WRITE !,"Unable to copy - the following error was encountered while "
+7 WRITE $SELECT(TYPE:"filing",1:"retrieving")," the data:"
+8 SET Z=0
FOR
SET Z=$ORDER(ERROR("DIERR",Z))
if 'Z
QUIT
Begin DoDot:2
+9 SET STR=$GET(ERROR("DIERR",Z))
IF STR'=""
WRITE !,"Error code: "_STR
+10 SET STR=$GET(ERROR("DIERR",Z,"PARAM","FILE"))
IF STR'=""
WRITE !,"File number: "_STR
+11 SET STR=$GET(ERROR("DIERR",Z,"PARAM","FIELD"))
IF STR'=""
WRITE !,"Field number: "_STR
+12 WRITE !,"Error text:"
SET Z1=0
FOR
SET Z1=$ORDER(ERROR("DIERR",1,"TEXT",Z1))
if 'Z1
QUIT
WRITE !,ERROR("DIERR",1,"TEXT",Z1)
+13 QUIT
End DoDot:2
+14 SET DIR(0)="EA"
SET DIR("A")="Press RETURN to continue "
DO ^DIR
+15 QUIT
End DoDot:1
+16 QUIT
+17 ;
MLTCPY(SFNUM,NEWIENS) ; copy a multiple
+1 ; SFNUM - sub-file number of a multiple to copy
+2 ; NEWIENS - iens of a new entry (copied to)
+3 ; OLDENTRY - FDA array to get data from (defined in the calling tag)
+4 ;
+5 ; returns 1 on successful copy, 0 on failure
+6 ;
+7 NEW ERROR,NEWENTRY,RES,STOPFLG,Z
+8 SET RES=1
SET STOPFLG=0
+9 SET Z=0
FOR
SET Z=$ORDER(OLDENTRY(SFNUM,Z))
if 'Z
QUIT
Begin DoDot:1
+10 KILL NEWENTRY
DO FDACPY(SFNUM,Z,"+1,"_NEWIENS,.OLDENTRY,.NEWENTRY)
+11 DO UPDATE^DIE(,"NEWENTRY",,"ERROR")
+12 IF $DATA(ERROR)
DO COPYERR(1)
SET STOPFLG=1
SET RES=0
+13 QUIT
End DoDot:1
if STOPFLG
QUIT
+14 QUIT RES
+15 ;
FDACPY(FN,OLDIENS,NEWIENS,OLDENTRY,NEWENTRY) ; copy FDA array, move data from "I" nodes to regular ones
+1 ; FN - file or subfile #
+2 ; OLDIENS - IENS for the OLDENTRY array
+3 ; NEWIENS - IENS for the NEWENTRY array
+4 ; OLDENTRY - array to copy from (passed by reference)
+5 ; NEWENTRY - array to copy into (passed by reference)
+6 ;
+7 NEW FLD,VALUE
+8 SET FLD=""
FOR
SET FLD=$ORDER(OLDENTRY(FN,OLDIENS,FLD))
if FLD=""
QUIT
Begin DoDot:1
+9 SET VALUE=$GET(OLDENTRY(FN,OLDIENS,FLD,"I"))
+10 IF VALUE'=""
SET NEWENTRY(FN,NEWIENS,FLD)=VALUE
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
MLTCLEAR(IBTRIEN) ; delete entries from multiples in file 356.22
+1 ; IBTRIEN - file 356.22 ien
+2 NEW DA,DIK,FLD,Z
+3 IF +$GET(IBTRIEN)'>0
QUIT
+4 FOR FLD=3,11,13,14,15,16
Begin DoDot:1
+5 SET DIK="^IBT(356.22,"_IBTRIEN_","_FLD_","
SET DA(1)=IBTRIEN
+6 SET DA=0
FOR
SET DA=$ORDER(^IBT(356.22,IBTRIEN,FLD,DA))
if 'DA!(DA?1.A)
QUIT
DO ^DIK
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
ADDR(FILE,IEN,LN1FLD,LN2FLD,LN3FLD,CITFLD,STFLD,ZIPFLD,RES) ; format address for output
+1 ; FILE - file number to get address from
+2 ; IEN - ien in FILE
+3 ; LN1FLD - field # for addr. line 1
+4 ; LN2FLD - field # for addr. line 2
+5 ; LN3FLD - field # for addr. line 3
+6 ; CITFLD - field # for city
+7 ; STFLD - field # for state
+8 ; ZIPFLD - field # for zip
+9 ; RES - array of formatted address lines this function returns
+10 ;
+11 NEW ADDRDATA,DRSTR,CNT,CSSTR,IENS,LN1STR,LN2STR,LN3STR,STATE,TMP,Z,Z1,Z2,ZIP
+12 KILL RES
SET RES(1)=""
+13 SET IENS=IEN_","
+14 SET DRSTR=LN1FLD_";"_LN2FLD_";"_LN3FLD_";"_CITFLD_";"_STFLD_";"_ZIPFLD
+15 DO GETS^DIQ(FILE,IENS,DRSTR,"EI","ADDRDATA")
+16 SET CSSTR=$GET(ADDRDATA(FILE,IENS,CITFLD,"E"))
+17 SET STATE=$$GET1^DIQ(5,$GET(ADDRDATA(FILE,IENS,STFLD,"I"))_",",1)
+18 SET ZIP=$GET(ADDRDATA(FILE,IENS,ZIPFLD,"E"))
+19 SET TMP=$EXTRACT(ZIP,6,9)
SET ZIP=$EXTRACT(ZIP,1,5)_$SELECT(TMP'="":"-"_TMP,1:"")
+20 SET STATE=STATE_$SELECT(STATE=""!(ZIP=""):"",1:" ")_ZIP
+21 SET CSSTR=CSSTR_$SELECT(CSSTR=""!(STATE=""):"",1:", ")_STATE
+22 SET LN1STR=$GET(ADDRDATA(FILE,IENS,LN1FLD,"E"))
SET LN2STR=$GET(ADDRDATA(FILE,IENS,LN2FLD,"E"))
SET LN3STR=$GET(ADDRDATA(FILE,IENS,LN3FLD,"E"))
+23 SET CNT=1
FOR Z=LN1STR,LN2STR,LN3STR,CSSTR
IF Z'=""
SET Z1=$GET(RES(CNT))
SET Z2=", "
Begin DoDot:1
+24 if Z1=""
SET Z2=""
if ($LENGTH(Z1)+2+$LENGTH(Z))>64
SET Z2=""
SET CNT=CNT+1
SET RES(CNT)=$GET(RES(CNT))_Z2_Z
+25 QUIT
End DoDot:1
+26 QUIT
+27 ;
STATMSG(TYPE) ; display transmission status message
+1 ; TYPE - 1 if transmission successful, 0 otherwise
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+3 SET DIR(0)="EA"
+4 SET DIR("A",1)=" "
+5 IF TYPE=0
SET DIR("A",2)="278 request has been sent successfully."
+6 IF TYPE=1
SET DIR("A",2)="Unable to send 278 request, can't find an entry in file 356.22."
+7 IF TYPE=2
SET DIR("A",2)="Unable to send 278 request, check HCSR worklist entry for errors."
+8 IF TYPE=3
SET DIR("A",2)="Unable to send 278 request, there's already a 278 request awaiting a response."
+9 IF TYPE=4
SET DIR("A",2)="This 278 request has a pending response from the payer. Please use SI action to send Inquiry if needed."
+10 SET DIR("A")="Press RETURN to continue "
DO ^DIR
+11 QUIT
+12 ;
MSG215(TYPE,TTYPE) ; display transmission status message
+1 ; TYPE - 1 if transmission successful, 0 otherwise
+2 ; TTYPE - 'C' for 278x215 cancel transaction
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+4 SET DIR(0)="EA"
+5 SET DIR("A",1)=" "
+6 IF TYPE=0
SET DIR("A",2)="278 "_$SELECT($GET(TTYPE)="C":"Cancellation",1:"Inquiry")_" has been sent successfully."
+7 IF TYPE=1
SET DIR("A",2)="Unable to send 278 Inquiry, can't find an entry in file 356.22."
+8 IF TYPE=2
SET DIR("A",2)="Unable to send 278 "_$SELECT($GET(TTYPE)="C":"Cancellation",1:"Inquiry")_", check HCSR worklist entry for errors."
+9 IF TYPE=3
SET DIR("A",2)="Unable to send 278 Inquiry, HCSR worklist entry is NOT in a 'Pending' status."
+10 IF TYPE=4
SET DIR("A",2)="Unable to generate 278 Inquiry, copy of existing entry failed"
+11 IF TYPE=5
SET DIR("A",2)="278x215 Inquiry has already been generated for this HCSR worklist entry."
+12 SET DIR("A")="Press RETURN to continue "
DO ^DIR
+13 QUIT
+14 ;
COPY278 ; copy 278 request
+1 ; requires IBTRIEN to be defined and contain ien of the 356.22 entry being copied
+2 ;
+3 NEW COB,COBSTR,CURCOB,DFN,DIR,DIROUT,DIRUT,DTOUT,DUOUT,ERROR,EVENTDT,IEN312,IENARRY,IENS,INSNODE0,INSDATA,LIST,NODE0
+4 NEW NEWENTRY,NIENS,NIENS16,OLDENTRY,OLDWP,SAVEIEN,STOPFLG,TMP,X,Y,Z,Z1,IBRESP,IBTRENT,NEWIEN,PAYIEN,STOP
+5 SET VALMBCK="R"
+6 IF +$GET(IBTRIEN)'>0
QUIT
+7 SET NODE0=$GET(^IBT(356.22,IBTRIEN,0))
+8 SET DFN=+$PIECE(NODE0,U,2)
SET IEN312=+$PIECE(NODE0,U,3)
+9 ; 0-node in file 2.312
SET INSNODE0=""
if IEN312>0
SET INSNODE0=$GET(^DPT(DFN,.312,IEN312,0))
+10 ; COB for the 356.22 entry we're working on
SET CURCOB=$PIECE(INSNODE0,U,20)
+11 SET EVENTDT=$PIECE(NODE0,U,7)
+12 ; build a list of existing entries for this patient and event date
+13 SET Z=""
FOR
SET Z=$ORDER(^IBT(356.22,"D",DFN,EVENTDT,Z))
if 'Z
QUIT
Begin DoDot:1
+14 SET NODE0=$GET(^IBT(356.22,Z,0))
+15 ; inquiry pointer exists - this is a response entry
IF +$PIECE(NODE0,U,13)>0
QUIT
+16 SET IEN312=+$PIECE(NODE0,U,3)
IF IEN312>0
IF $GET(LIST(IEN312))=""
SET LIST(IEN312)=Z_U_$$STATUS^IBTRH2(Z)
+17 QUIT
End DoDot:1
+18 DO ALL^IBCNS1(DFN,"INSDATA",1,$PIECE(EVENTDT,"-"),1)
+19 ; need at least 2 insurance policies to be available
IF INSDATA(0)<2
DO MSG(1)
QUIT
+20 SET STOPFLG=0
+21 FOR COB=1:1:3
SET IEN312=$ORDER(INSDATA("S",COB,""))
IF IEN312'=""
IF COB'=CURCOB
Begin DoDot:1
+22 SET PAYIEN=$PIECE($GET(^DPT(DFN,.312,IEN312,0)),"^")
IF PAYIEN=""
SET STOPFLG=1
QUIT
+23 IF '$DATA(^IBE(350.9,1,$SELECT($PIECE(NODE0,"^",4):66,1:65),"B",PAYIEN))
SET STOP=2
QUIT
+24 ; already sent request for this entry
IF +$PIECE($GET(LIST(IEN312)),U,2)>1
SET STOP=3
QUIT
+25 SET COBSTR=$SELECT(COB=1:"primary",COB=2:"secondary",1:"tertiary")
+26 SET DIR("A")="Copy 278 request to "_COBSTR_" insurance? (Y/N): "
SET DIR("B")="Y"
SET DIR(0)="YAO"
DO ^DIR
KILL DIR
+27 IF $GET(DTOUT)!$GET(DUOUT)!$GET(DIROUT)!($GET(Y)'=1)
QUIT
+28 ; copy the entry in 356.22
+29 SET STOP=4
+30 SET IENS=IBTRIEN_","
+31 DO GETS^DIQ(356.22,IENS,".02;.04:.07;.16;2.01:2.25;3*;4.01:4.14;5.01:5.18;6.01:6.18;7.01:7.13;8.01:8.08;9.01:9.08;10.01:10.13;11*;14*;15*;18.01:18.1","IN","OLDENTRY","ERROR")
+32 IF $DATA(ERROR)
DO COPYERR(0)
SET STOPFLG=1
QUIT
+33 ; iens of the new entry in 356.22 (top level)
SET NIENS=+$GET(LIST(IEN312))_","
+34 IF NIENS="0,"
SET NIENS="+1,"
SET NEWENTRY(356.22,NIENS,.01)=$$NOW^XLFDT()
+35 DO FDACPY(356.22,IENS,NIENS,.OLDENTRY,.NEWENTRY)
+36 SET NEWENTRY(356.22,NIENS,.03)=IEN312
+37 SET NEWENTRY(356.22,NIENS,.11)=DUZ
+38 ; WP field 356.22/12
+39 DO GETS^DIQ(356.22,IENS,"12","N","OLDWP","ERROR")
IF $DATA(ERROR)
DO COPYERR(0)
SET STOPFLG=1
QUIT
+40 MERGE NEWENTRY(356.22,NIENS,12)=OLDWP(356.22,IENS,12)
+41 IF NIENS="+1,"
DO UPDATE^DIE(,"NEWENTRY","NEWIEN","ERROR")
+42 IF NIENS'="+1,"
DO FILE^DIE(,"NEWENTRY","ERROR")
+43 IF $DATA(ERROR)
DO COPYERR(1)
SET STOPFLG=1
QUIT
+44 IF $DATA(NEWIEN(1))
SET NIENS=NEWIEN(1)_","
SET LIST(IEN312)=NEWIEN(1)
+45 DO MLTCLEAR($PIECE(NIENS,","))
+46 ; multiple 356.223
+47 IF '$$MLTCPY(356.223,NIENS)
SET STOPFLG=1
QUIT
+48 ; multiple 356.2211
+49 IF '$$MLTCPY(356.2211,NIENS)
SET STOPFLG=1
QUIT
+50 ; multiple 356.2214
+51 IF '$$MLTCPY(356.2214,NIENS)
SET STOPFLG=1
QUIT
+52 ; multiple 356.2215
+53 IF '$$MLTCPY(356.2215,NIENS)
SET STOPFLG=1
QUIT
+54 ; multiple 356.2213 - not all fields are being copied, each entry needs to be handled separately
+55 SET Z=0
FOR
SET Z=$ORDER(^IBT(356.22,IBTRIEN,13,Z))
if 'Z
QUIT
Begin DoDot:2
+56 SET IENS=Z_","_IBTRIEN_","
KILL NEWENTRY,OLDENTRY
+57 DO GETS^DIQ(356.2213,IENS,".01:.03","IN","OLDENTRY","ERROR")
+58 IF $DATA(ERROR)
DO COPYERR(0)
SET STOPFLG=1
QUIT
+59 DO FDACPY(356.2213,IENS,"+1,"_NIENS,.OLDENTRY,.NEWENTRY)
+60 DO UPDATE^DIE(,"NEWENTRY",,"ERROR")
+61 IF $DATA(ERROR)
DO COPYERR(1)
SET STOPFLG=1
+62 QUIT
End DoDot:2
if STOPFLG
QUIT
+63 ; multiple 356.2216 - not all fields are being copied, each entry needs to be handled separately
+64 SET Z=0
FOR
SET Z=$ORDER(^IBT(356.22,IBTRIEN,16,Z))
if 'Z
QUIT
Begin DoDot:2
+65 SET IENS=Z_","_IBTRIEN_","
KILL OLDENTRY
+66 DO GETS^DIQ(356.2216,IENS,".01:.14;1.01:1.12;2.01:2.09;3.01:3.07;4*;5.01:5.08;6*","IN","OLDENTRY","ERROR")
+67 IF $DATA(ERROR)
DO COPYERR(0)
SET STOPFLG=1
QUIT
+68 KILL NEWENTRY
DO FDACPY(356.2216,IENS,"+1,"_NIENS,.OLDENTRY,.NEWENTRY)
+69 ; WP field 356.2216/7
+70 KILL OLDWP
DO GETS^DIQ(356.2216,IENS,"7","N","OLDWP","ERROR")
IF $DATA(ERROR)
DO COPYERR(0)
SET STOPFLG=1
QUIT
+71 MERGE NEWENTRY(356.2216,"+1,"_NIENS,7)=OLDWP(356.2216,IENS,7)
+72 KILL IENARRY
DO UPDATE^DIE(,"NEWENTRY","IENARRY","ERROR")
+73 IF $DATA(ERROR)
DO COPYERR(1)
SET STOPFLG=1
QUIT
+74 ; iens of the new entry in 356.2216
SET NIENS16=IENARRY(1)_","_NIENS
+75 ; multiple 356.22164
+76 IF '$$MLTCPY(356.22164,NIENS16)
SET STOPFLG=1
QUIT
+77 ; multiple 356.22166
+78 IF '$$MLTCPY(356.22166,NIENS16)
SET STOPFLG=1
QUIT
+79 ; multiple 356.22167
+80 IF '$$MLTCPY(356.22166,NIENS16)
SET STOPFLG=1
QUIT
+81 ; multiple 356.22168 - not all fields are being copied, each entry needs to be handled separately
+82 SET Z1=0
FOR
SET Z1=$ORDER(^IBT(356.22,IBTRIEN,16,Z,8,Z1))
if 'Z1
QUIT
Begin DoDot:3
+83 SET IENS=Z1_","_Z_","_IBTRIEN_","
KILL NEWENTRY,OLDENTRY
+84 DO GETS^DIQ(356.22168,IENS,".01:.03","IN","OLDENTRY","ERROR")
+85 IF $DATA(ERROR)
DO COPYERR(0)
SET STOPFLG=1
QUIT
+86 DO FDACPY(356.22168,IENS,"+1,"_NIENS16,.OLDENTRY,.NEWENTRY)
+87 DO UPDATE^DIE(,"NEWENTRY",,"ERROR")
+88 IF $DATA(ERROR)
DO COPYERR(1)
SET STOPFLG=1
+89 QUIT
End DoDot:3
if STOPFLG
QUIT
+90 QUIT
End DoDot:2
if STOPFLG
QUIT
+91 ; ask if new 278 request should be sent right away
+92 SET SAVEIEN=IBTRIEN
SET IBTRIEN=+$GET(LIST(IEN312))
SET IBTRENT=0
DO SEND278^IBTRH2
SET IBTRIEN=SAVEIEN
+93 QUIT
End DoDot:1
if STOPFLG
QUIT
+94 IF +$GET(STOP)>0
IF +$GET(STOP)<4
DO MSG(STOP)
+95 QUIT
+96 ;
MSG(TYPE) ;display status message
+1 ; TYPE = 1 No alternate insurance available for this patient
+2 ; = 2 alternate insurance not setup for 278 submission
+3 ; = 3 278 already created for alternate insurance
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+5 SET DIR(0)="EA"
+6 SET DIR("A",1)=" "
+7 IF TYPE=1
SET DIR("A",2)="No alternate insurance available for this patient."
+8 IF TYPE=2
SET DIR("A",2)="Alternate insurance is not enabled for 278 submission."
+9 IF TYPE=3
SET DIR("A",2)="A 278 is already submitted for the alternate insurance."
+10 SET DIR("A")="Press RETURN to continue "
DO ^DIR
+11 QUIT
