IBCNES3 ;DALOI/KML/JNM - eIV elig/Benefit screen, con't ;01-05-2016
;;2.0;INTEGRATED BILLING;**497,549**;21-MAR-94;Build 54
;;Per VA Directive 6402, this routine should not be modified.
;
Q
; called by IBCNES
RPDM(IBVF,IBVDA,IBVV,IBVSUB) ; Eligibility/Group Information procedure
; --- Called by IBCNES
; input
; IBVF = file file# 2.322 or 365.02
; IBVDA - ien of 365 OR 2.312
S IBVV=+$G(IBVV)
N IBL,IBY,IBLINE,LN,DSP,COL1,COL2,GLO
;^DPT(D0,.312,D1,9,0)
I IBVF=2.312 S GLO=$NA(^DPT(+$G(IBVDA(1)),.312,+$G(IBVDA))) ; pt. insurance
I IBVF=365 S GLO=$NA(^IBCN(365,+$G(IBVDA))) ; response file
S DSP=$NA(^TMP(IBVSUB,$J,"DISP")) ; scratch global display array
S LN=+$O(@DSP@(""),-1) ; last line# used in scratch global
S COL1=2,COL2=47
;
S LN=LN+1
D SET^IBCNES1(LN,1,"Eligibility/Group Plan Information",,IBVV)
S LN=LN+1
D SET^IBCNES1(LN)
D REF(GLO,IBVF,.IBVDA)
D PROV(GLO,IBVF,.IBVDA)
D DIAG(GLO,IBVF,.IBVDA)
D MIL(GLO,IBVF,.IBVDA)
Q
;
REF(GLO,IBVF,IBVDA) ; policy level reference ID display
;
; input -
N REF,SIEN,IENS,REFLST
S IBVF=$S(IBVF=365:365.09,1:2.3129)
S SIEN=0 F S SIEN=$O(@GLO@(9,SIEN)) Q:'SIEN S REFLST(SIEN)=""
I '$D(REFLST) S REFLST(1)="" ; field labels need to display once even if no values exist
S SIEN=0 F S SIEN=$O(REFLST(SIEN)) Q:'SIEN D
. S IENS=$S(IBVF=365.09:SIEN_","_IBVDA_",",1:SIEN_","_IBVDA_","_IBVDA(1)_",")
. D GETS^DIQ(IBVF,IENS,"*","IEN","REF")
. D SET^IBCNES1(LN,COL1,"Reference ID Qualifier",$P($G(^IBE(365.028,+$G(REF(IBVF,IENS,.03,"I")),0)),U,2))
. D SET^IBCNES1(.LN,COL2,"Reference ID",$G(REF(IBVF,IENS,.02,"E")))
. S LN=LN+1
. D SET^IBCNES1(LN,COL1,"Reference ID description",$G(REF(IBVF,IENS,.04,"E")))
. S LN=LN+1
. D SET^IBCNES1(LN)
S LN=LN+1
D SET^IBCNES1(LN)
Q
;
PROV(GLO,IBVF,IBVDA) ; GROUP level provider info
; input
; RIEN - ien of 365
N PVLIST,SIEN,IENS,PV
S IBVF=$S(IBVF=365:365.04,1:2.332)
S SIEN=0 F S SIEN=$O(@GLO@(10,SIEN)) Q:'SIEN S PVLIST(SIEN)=""
I '$D(PVLIST) S PVLIST(1)="" ; field labels need to display once even if no values exist
S SIEN=0 F S SIEN=$O(PVLIST(SIEN)) Q:'SIEN D
. S IENS=$S(IBVF=365.04:SIEN_","_IBVDA_",",1:SIEN_","_IBVDA_","_IBVDA(1)_",")
. D GETS^DIQ(IBVF,IENS,"*","IEN","PV")
. D SET^IBCNES1(LN,COL1,"Provider Code",$P($G(^IBE(365.024,+$G(PV(IBVF,IENS,.02,"I")),0)),U,2))
. S LN=LN+1
. D SET^IBCNES1(LN,COL1,"Reference ID",$G(PV(IBVF,IENS,.03,"E")))
. S LN=LN+1
. D SET^IBCNES1(LN)
S LN=LN+1
D SET^IBCNES1(LN)
Q
;
DIAG(GLO,IBVF,IBVDA) ; DIAGNOSIS INFO
N IENS,SIEN,HDLIST,DIAG,ICDSTR,PRIMSEC
S IBVF=$S(IBVF=365:365.01,1:2.31211)
S SIEN=0 F S SIEN=$O(@GLO@(11,SIEN)) Q:'SIEN S HDLIST(SIEN)=""
I '$D(HDLIST) S HDLIST(1)="" ; field labels need to display once even if no values exist
S SIEN=0 F S SIEN=$O(HDLIST(SIEN)) Q:'SIEN D
. S IENS=$S(IBVF=365.01:SIEN_","_IBVDA_",",1:SIEN_","_IBVDA_","_IBVDA(1)_",")
. D GETS^DIQ(IBVF,IENS,"*","IEN","DIAG")
. S ICDSTR=$G(^ICD9(+$G(DIAG(IBVF,IENS,.02,"I")),0)) ; IA# 5388 (Supported agreement)
. S PRIMSEC=$G(DIAG(IBVF,IENS,.04,"I"))
. D SET^IBCNES1(LN,COL1,$S(PRIMSEC="P":"Primary ",PRIMSEC="":"Primary ",1:"Secondary ")_"Diagnosis Code",$P(ICDSTR,U)_" "_$P(ICDSTR,U,3))
. S LN=LN+1
. D SET^IBCNES1(LN)
S LN=LN+1
D SET^IBCNES1(LN)
Q
;
MIL(GLO,IBVF,IBVDA) ; military personnel information display
;
; input -
N IENS
S IENS=IBVDA_","
S IENS=$S(IBVF=365:IBVDA_",",1:IBVDA_","_IBVDA(1)_",")
S IBVF=$S(IBVF=365:365,1:2.312)
D GETS^DIQ(IBVF,IENS,"12.01:12.07","IEN","MIL")
D SET^IBCNES1(LN,COL1,"Military Info Status",$P($G(^IBE(365.039,+$G(MIL(IBVF,IENS,12.01,"I")),0)),U,2))
D SET^IBCNES1(.LN,COL2,"Employment Status",$P($G(^IBE(365.046,+$G(MIL(IBVF,IENS,12.02,"I")),0)),U,2))
S LN=LN+1
D SET^IBCNES1(LN,COL1,"Government Affiliation",$P($G(^IBE(365.041,+$G(MIL(IBVF,IENS,12.03,"I")),0)),U,2))
D SET^IBCNES1(.LN,COL2,"Date Time Period",$$DFMT(.MIL,IBVF,IENS))
S LN=LN+1
D SET^IBCNES1(LN,COL1,"Service Rank",$P($G(^IBE(365.042,+$G(MIL(IBVF,IENS,12.05,"I")),0)),U,2))
S LN=LN+1
D SET^IBCNES1(LN,COL1,"Desc",$G(MIL(IBVF,IENS,12.04,"E")))
S LN=LN+1
D SET^IBCNES1(LN)
Q
;
DFMT(MIL,IBVF,IENS) ; return proper date format string
;
; input - MIL = data array containing the data extracted from the military information fields (365, 12.01-12.07)
; IENS = ien of 365 entry or 2.312 entry
; output - RES = formatted date string
N TODT,FROMDT,RES
; date range
I $G(MIL(IBVF,IENS,12.06,"E"))="RD8" S FROMDT=$P($G(MIL(IBVF,IENS,12.07,"E")),"-"),TODT=$P($G(MIL(IBVF,IENS,12.07,"E")),"-",2),RES=$$FMTE^XLFDT($$HL7TFM^XLFDT(FROMDT),2)_" - "_$$FMTE^XLFDT($$HL7TFM^XLFDT(TODT),2)
E S RES=$$FMTE^XLFDT($$HL7TFM^XLFDT($G(MIL(IBVF,IENS,12.07,"E"))),2) ; single date
Q RES
;
SET(LN,DATA,COL) ;set display data in scratch global
N STR
S STR=""
S STR=$$SETSTR^VALM1(DATA,STR,+COL,(81-COL)) ; insert new data
S @DSP@(LN,0)=STR ; set the new data back into the scratch global
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNES3 5150 printed Apr 09, 2024@21:24:21 Page 2
IBCNES3 ;DALOI/KML/JNM - eIV elig/Benefit screen, con't ;01-05-2016
+1 ;;2.0;INTEGRATED BILLING;**497,549**;21-MAR-94;Build 54
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ; called by IBCNES
RPDM(IBVF,IBVDA,IBVV,IBVSUB) ; Eligibility/Group Information procedure
+1 ; --- Called by IBCNES
+2 ; input
+3 ; IBVF = file file# 2.322 or 365.02
+4 ; IBVDA - ien of 365 OR 2.312
+5 SET IBVV=+$GET(IBVV)
+6 NEW IBL,IBY,IBLINE,LN,DSP,COL1,COL2,GLO
+7 ;^DPT(D0,.312,D1,9,0)
+8 ; pt. insurance
IF IBVF=2.312
SET GLO=$NAME(^DPT(+$GET(IBVDA(1)),.312,+$GET(IBVDA)))
+9 ; response file
IF IBVF=365
SET GLO=$NAME(^IBCN(365,+$GET(IBVDA)))
+10 ; scratch global display array
SET DSP=$NAME(^TMP(IBVSUB,$JOB,"DISP"))
+11 ; last line# used in scratch global
SET LN=+$ORDER(@DSP@(""),-1)
+12 SET COL1=2
SET COL2=47
+13 ;
+14 SET LN=LN+1
+15 DO SET^IBCNES1(LN,1,"Eligibility/Group Plan Information",,IBVV)
+16 SET LN=LN+1
+17 DO SET^IBCNES1(LN)
+18 DO REF(GLO,IBVF,.IBVDA)
+19 DO PROV(GLO,IBVF,.IBVDA)
+20 DO DIAG(GLO,IBVF,.IBVDA)
+21 DO MIL(GLO,IBVF,.IBVDA)
+22 QUIT
+23 ;
REF(GLO,IBVF,IBVDA) ; policy level reference ID display
+1 ;
+2 ; input -
+3 NEW REF,SIEN,IENS,REFLST
+4 SET IBVF=$SELECT(IBVF=365:365.09,1:2.3129)
+5 SET SIEN=0
FOR
SET SIEN=$ORDER(@GLO@(9,SIEN))
if 'SIEN
QUIT
SET REFLST(SIEN)=""
+6 ; field labels need to display once even if no values exist
IF '$DATA(REFLST)
SET REFLST(1)=""
+7 SET SIEN=0
FOR
SET SIEN=$ORDER(REFLST(SIEN))
if 'SIEN
QUIT
Begin DoDot:1
+8 SET IENS=$SELECT(IBVF=365.09:SIEN_","_IBVDA_",",1:SIEN_","_IBVDA_","_IBVDA(1)_",")
+9 DO GETS^DIQ(IBVF,IENS,"*","IEN","REF")
+10 DO SET^IBCNES1(LN,COL1,"Reference ID Qualifier",$PIECE($GET(^IBE(365.028,+$GET(REF(IBVF,IENS,.03,"I")),0)),U,2))
+11 DO SET^IBCNES1(.LN,COL2,"Reference ID",$GET(REF(IBVF,IENS,.02,"E")))
+12 SET LN=LN+1
+13 DO SET^IBCNES1(LN,COL1,"Reference ID description",$GET(REF(IBVF,IENS,.04,"E")))
+14 SET LN=LN+1
+15 DO SET^IBCNES1(LN)
End DoDot:1
+16 SET LN=LN+1
+17 DO SET^IBCNES1(LN)
+18 QUIT
+19 ;
PROV(GLO,IBVF,IBVDA) ; GROUP level provider info
+1 ; input
+2 ; RIEN - ien of 365
+3 NEW PVLIST,SIEN,IENS,PV
+4 SET IBVF=$SELECT(IBVF=365:365.04,1:2.332)
+5 SET SIEN=0
FOR
SET SIEN=$ORDER(@GLO@(10,SIEN))
if 'SIEN
QUIT
SET PVLIST(SIEN)=""
+6 ; field labels need to display once even if no values exist
IF '$DATA(PVLIST)
SET PVLIST(1)=""
+7 SET SIEN=0
FOR
SET SIEN=$ORDER(PVLIST(SIEN))
if 'SIEN
QUIT
Begin DoDot:1
+8 SET IENS=$SELECT(IBVF=365.04:SIEN_","_IBVDA_",",1:SIEN_","_IBVDA_","_IBVDA(1)_",")
+9 DO GETS^DIQ(IBVF,IENS,"*","IEN","PV")
+10 DO SET^IBCNES1(LN,COL1,"Provider Code",$PIECE($GET(^IBE(365.024,+$GET(PV(IBVF,IENS,.02,"I")),0)),U,2))
+11 SET LN=LN+1
+12 DO SET^IBCNES1(LN,COL1,"Reference ID",$GET(PV(IBVF,IENS,.03,"E")))
+13 SET LN=LN+1
+14 DO SET^IBCNES1(LN)
End DoDot:1
+15 SET LN=LN+1
+16 DO SET^IBCNES1(LN)
+17 QUIT
+18 ;
DIAG(GLO,IBVF,IBVDA) ; DIAGNOSIS INFO
+1 NEW IENS,SIEN,HDLIST,DIAG,ICDSTR,PRIMSEC
+2 SET IBVF=$SELECT(IBVF=365:365.01,1:2.31211)
+3 SET SIEN=0
FOR
SET SIEN=$ORDER(@GLO@(11,SIEN))
if 'SIEN
QUIT
SET HDLIST(SIEN)=""
+4 ; field labels need to display once even if no values exist
IF '$DATA(HDLIST)
SET HDLIST(1)=""
+5 SET SIEN=0
FOR
SET SIEN=$ORDER(HDLIST(SIEN))
if 'SIEN
QUIT
Begin DoDot:1
+6 SET IENS=$SELECT(IBVF=365.01:SIEN_","_IBVDA_",",1:SIEN_","_IBVDA_","_IBVDA(1)_",")
+7 DO GETS^DIQ(IBVF,IENS,"*","IEN","DIAG")
+8 ; IA# 5388 (Supported agreement)
SET ICDSTR=$GET(^ICD9(+$GET(DIAG(IBVF,IENS,.02,"I")),0))
+9 SET PRIMSEC=$GET(DIAG(IBVF,IENS,.04,"I"))
+10 DO SET^IBCNES1(LN,COL1,$SELECT(PRIMSEC="P":"Primary ",PRIMSEC="":"Primary ",1:"Secondary ")_"Diagnosis Code",$PIECE(ICDSTR,U)_" "_$PIECE(ICDSTR,U,3))
+11 SET LN=LN+1
+12 DO SET^IBCNES1(LN)
End DoDot:1
+13 SET LN=LN+1
+14 DO SET^IBCNES1(LN)
+15 QUIT
+16 ;
MIL(GLO,IBVF,IBVDA) ; military personnel information display
+1 ;
+2 ; input -
+3 NEW IENS
+4 SET IENS=IBVDA_","
+5 SET IENS=$SELECT(IBVF=365:IBVDA_",",1:IBVDA_","_IBVDA(1)_",")
+6 SET IBVF=$SELECT(IBVF=365:365,1:2.312)
+7 DO GETS^DIQ(IBVF,IENS,"12.01:12.07","IEN","MIL")
+8 DO SET^IBCNES1(LN,COL1,"Military Info Status",$PIECE($GET(^IBE(365.039,+$GET(MIL(IBVF,IENS,12.01,"I")),0)),U,2))
+9 DO SET^IBCNES1(.LN,COL2,"Employment Status",$PIECE($GET(^IBE(365.046,+$GET(MIL(IBVF,IENS,12.02,"I")),0)),U,2))
+10 SET LN=LN+1
+11 DO SET^IBCNES1(LN,COL1,"Government Affiliation",$PIECE($GET(^IBE(365.041,+$GET(MIL(IBVF,IENS,12.03,"I")),0)),U,2))
+12 DO SET^IBCNES1(.LN,COL2,"Date Time Period",$$DFMT(.MIL,IBVF,IENS))
+13 SET LN=LN+1
+14 DO SET^IBCNES1(LN,COL1,"Service Rank",$PIECE($GET(^IBE(365.042,+$GET(MIL(IBVF,IENS,12.05,"I")),0)),U,2))
+15 SET LN=LN+1
+16 DO SET^IBCNES1(LN,COL1,"Desc",$GET(MIL(IBVF,IENS,12.04,"E")))
+17 SET LN=LN+1
+18 DO SET^IBCNES1(LN)
+19 QUIT
+20 ;
DFMT(MIL,IBVF,IENS) ; return proper date format string
+1 ;
+2 ; input - MIL = data array containing the data extracted from the military information fields (365, 12.01-12.07)
+3 ; IENS = ien of 365 entry or 2.312 entry
+4 ; output - RES = formatted date string
+5 NEW TODT,FROMDT,RES
+6 ; date range
+7 IF $GET(MIL(IBVF,IENS,12.06,"E"))="RD8"
SET FROMDT=$PIECE($GET(MIL(IBVF,IENS,12.07,"E")),"-")
SET TODT=$PIECE($GET(MIL(IBVF,IENS,12.07,"E")),"-",2)
SET RES=$$FMTE^XLFDT($$HL7TFM^XLFDT(FROMDT),2)_" - "_$$FMTE^XLFDT($$HL7TFM^XLFDT(TODT),2)
+8 ; single date
IF '$TEST
SET RES=$$FMTE^XLFDT($$HL7TFM^XLFDT($GET(MIL(IBVF,IENS,12.07,"E"))),2)
+9 QUIT RES
+10 ;
SET(LN,DATA,COL) ;set display data in scratch global
+1 NEW STR
+2 SET STR=""
+3 ; insert new data
SET STR=$$SETSTR^VALM1(DATA,STR,+COL,(81-COL))
+4 ; set the new data back into the scratch global
SET @DSP@(LN,0)=STR
+5 QUIT
+6 ;
