Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNES3

IBCNES3.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ; called by IBCNES
  1. RPDM(IBVF,IBVDA,IBVV,IBVSUB) ; Eligibility/Group Information procedure
  1.  ; --- Called by IBCNES
  1.  ;          input
  1.  ;              IBVF = file file# 2.322 or 365.02
  1.  ;              IBVDA - ien of 365 OR 2.312
  1.  S IBVV=+$G(IBVV)
  1.  N IBL,IBY,IBLINE,LN,DSP,COL1,COL2,GLO
  1.  ;^DPT(D0,.312,D1,9,0)
  1.  I IBVF=2.312 S GLO=$NA(^DPT(+$G(IBVDA(1)),.312,+$G(IBVDA)))   ; pt. insurance
  1.  I IBVF=365 S GLO=$NA(^IBCN(365,+$G(IBVDA)))                ; response file
  1.  S DSP=$NA(^TMP(IBVSUB,$J,"DISP"))       ; scratch global display array
  1.  S LN=+$O(@DSP@(""),-1)                  ; last line# used in scratch global
  1.  S COL1=2,COL2=47
  1.  ;
  1.  S LN=LN+1
  1.  D SET^IBCNES1(LN,1,"Eligibility/Group Plan Information",,IBVV)
  1.  S LN=LN+1
  1.  D SET^IBCNES1(LN)
  1.  D REF(GLO,IBVF,.IBVDA)
  1.  D PROV(GLO,IBVF,.IBVDA)
  1.  D DIAG(GLO,IBVF,.IBVDA)
  1.  D MIL(GLO,IBVF,.IBVDA)
  1.  Q
  1.  ;
  1. REF(GLO,IBVF,IBVDA) ;  policy level reference ID display
  1.  ; 
  1.  ;    input - 
  1.  N REF,SIEN,IENS,REFLST
  1.  S IBVF=$S(IBVF=365:365.09,1:2.3129)
  1.  S SIEN=0 F  S SIEN=$O(@GLO@(9,SIEN)) Q:'SIEN  S REFLST(SIEN)=""
  1.  I '$D(REFLST) S REFLST(1)=""  ; field labels need to display once even if no values exist
  1.  S SIEN=0 F  S SIEN=$O(REFLST(SIEN)) Q:'SIEN  D
  1.  . S IENS=$S(IBVF=365.09:SIEN_","_IBVDA_",",1:SIEN_","_IBVDA_","_IBVDA(1)_",")
  1.  . D GETS^DIQ(IBVF,IENS,"*","IEN","REF")
  1.  . D SET^IBCNES1(LN,COL1,"Reference ID Qualifier",$P($G(^IBE(365.028,+$G(REF(IBVF,IENS,.03,"I")),0)),U,2))
  1.  . D SET^IBCNES1(.LN,COL2,"Reference ID",$G(REF(IBVF,IENS,.02,"E")))
  1.  . S LN=LN+1
  1.  . D SET^IBCNES1(LN,COL1,"Reference ID description",$G(REF(IBVF,IENS,.04,"E")))
  1.  . S LN=LN+1
  1.  . D SET^IBCNES1(LN)
  1.  S LN=LN+1
  1.  D SET^IBCNES1(LN)
  1.  Q
  1.  ;
  1. PROV(GLO,IBVF,IBVDA) ; GROUP level provider info
  1.  ;          input
  1.  ;              RIEN - ien of 365
  1.  N PVLIST,SIEN,IENS,PV
  1.  S IBVF=$S(IBVF=365:365.04,1:2.332)
  1.  S SIEN=0 F  S SIEN=$O(@GLO@(10,SIEN)) Q:'SIEN  S PVLIST(SIEN)=""
  1.  I '$D(PVLIST) S PVLIST(1)=""  ; field labels need to display once even if no values exist
  1.  S SIEN=0 F  S SIEN=$O(PVLIST(SIEN)) Q:'SIEN  D
  1.  . S IENS=$S(IBVF=365.04:SIEN_","_IBVDA_",",1:SIEN_","_IBVDA_","_IBVDA(1)_",")
  1.  . D GETS^DIQ(IBVF,IENS,"*","IEN","PV")
  1.  . D SET^IBCNES1(LN,COL1,"Provider Code",$P($G(^IBE(365.024,+$G(PV(IBVF,IENS,.02,"I")),0)),U,2))
  1.  . S LN=LN+1
  1.  . D SET^IBCNES1(LN,COL1,"Reference ID",$G(PV(IBVF,IENS,.03,"E")))
  1.  . S LN=LN+1
  1.  . D SET^IBCNES1(LN)
  1.  S LN=LN+1
  1.  D SET^IBCNES1(LN)
  1.  Q
  1.  ;
  1. DIAG(GLO,IBVF,IBVDA) ; DIAGNOSIS INFO
  1.  N IENS,SIEN,HDLIST,DIAG,ICDSTR,PRIMSEC
  1.  S IBVF=$S(IBVF=365:365.01,1:2.31211)
  1.  S SIEN=0 F  S SIEN=$O(@GLO@(11,SIEN)) Q:'SIEN  S HDLIST(SIEN)=""
  1.  I '$D(HDLIST) S HDLIST(1)=""  ; field labels need to display once even if no values exist
  1.  S SIEN=0 F  S SIEN=$O(HDLIST(SIEN)) Q:'SIEN  D
  1.  . S IENS=$S(IBVF=365.01:SIEN_","_IBVDA_",",1:SIEN_","_IBVDA_","_IBVDA(1)_",")
  1.  . D GETS^DIQ(IBVF,IENS,"*","IEN","DIAG")
  1.  . S ICDSTR=$G(^ICD9(+$G(DIAG(IBVF,IENS,.02,"I")),0))  ; IA# 5388 (Supported agreement)
  1.  . S PRIMSEC=$G(DIAG(IBVF,IENS,.04,"I"))
  1.  . D SET^IBCNES1(LN,COL1,$S(PRIMSEC="P":"Primary ",PRIMSEC="":"Primary ",1:"Secondary ")_"Diagnosis Code",$P(ICDSTR,U)_" "_$P(ICDSTR,U,3))
  1.  . S LN=LN+1
  1.  . D SET^IBCNES1(LN)
  1.  S LN=LN+1
  1.  D SET^IBCNES1(LN)
  1.  Q
  1.  ;
  1. MIL(GLO,IBVF,IBVDA) ; military personnel information display
  1.  ; 
  1.  ;    input - 
  1.  N IENS
  1.  S IENS=IBVDA_","
  1.  S IENS=$S(IBVF=365:IBVDA_",",1:IBVDA_","_IBVDA(1)_",")
  1.  S IBVF=$S(IBVF=365:365,1:2.312)
  1.  D GETS^DIQ(IBVF,IENS,"12.01:12.07","IEN","MIL")
  1.  D SET^IBCNES1(LN,COL1,"Military Info Status",$P($G(^IBE(365.039,+$G(MIL(IBVF,IENS,12.01,"I")),0)),U,2))
  1.  D SET^IBCNES1(.LN,COL2,"Employment Status",$P($G(^IBE(365.046,+$G(MIL(IBVF,IENS,12.02,"I")),0)),U,2))
  1.  S LN=LN+1
  1.  D SET^IBCNES1(LN,COL1,"Government Affiliation",$P($G(^IBE(365.041,+$G(MIL(IBVF,IENS,12.03,"I")),0)),U,2))
  1.  D SET^IBCNES1(.LN,COL2,"Date Time Period",$$DFMT(.MIL,IBVF,IENS))
  1.  S LN=LN+1
  1.  D SET^IBCNES1(LN,COL1,"Service Rank",$P($G(^IBE(365.042,+$G(MIL(IBVF,IENS,12.05,"I")),0)),U,2))
  1.  S LN=LN+1
  1.  D SET^IBCNES1(LN,COL1,"Desc",$G(MIL(IBVF,IENS,12.04,"E")))
  1.  S LN=LN+1
  1.  D SET^IBCNES1(LN)
  1.  Q
  1.  ;
  1. DFMT(MIL,IBVF,IENS) ;  return proper date format string
  1.  ; 
  1.  ;    input - MIL = data array containing the data extracted from the military information fields (365, 12.01-12.07)
  1.  ;            IENS = ien of 365 entry or 2.312 entry
  1.  ;    output - RES = formatted date string
  1.  N TODT,FROMDT,RES
  1.  ; date range  
  1.  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)
  1.  E  S RES=$$FMTE^XLFDT($$HL7TFM^XLFDT($G(MIL(IBVF,IENS,12.07,"E"))),2)  ; single date
  1.  Q RES
  1.  ;
  1. SET(LN,DATA,COL) ;set display data in scratch global
  1.  N STR
  1.  S STR=""
  1.  S STR=$$SETSTR^VALM1(DATA,STR,+COL,(81-COL))   ; insert new data
  1.  S @DSP@(LN,0)=STR ; set the new data back into the scratch global
  1.  Q
  1.  ;