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

BADEHLI.m

Go to the documentation of this file. 
  1. BADEHLI ;IHS/MSC/MGH/PLS - Insurance or Dental Interface ;08-May-2009 20:54;PLS
  1.  ;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011
  1.  ;; Modified IHS/MSC/AMF 11/23/10 More descriptive alert messages, N for BHS variables
  1.  ;=====================================================================================;
  1. INS ;Entry point - Create the Insurance segment
  1.  N CNT,INSARRAY,DGNAME,IN1,IN2
  1.  ;IHS/MSC/AMF 1/4/2011 Newed BHS variables
  1.  N BHSCOV,BHSDTL,BHSDTN,BHSDTS,BHSEDN,BHSI,BHSIDN,BHSINS,BHSITB,BHSJ,BHSN,BHSNM,BHSP,BHSPDN,BHSUFF,BHSXDT,BHSQ
  1.  S CNT=0
  1.  D MAID,MCARE,THIRD,RR
  1.  I 'CNT D
  1.  .D CRTNULL   ;force creation of empty IN1/IN2 segments
  1.  Q
  1. MAID ;See if the patient is on MEDICAID
  1.  K BHSITB
  1.  S BHSPDN=0 F  S BHSPDN=$O(^AUPNMCD("B",DFN,BHSPDN)) Q:BHSPDN=""  D BMAID
  1.  S BHSI=0 F  S BHSI=$O(BHSITB(BHSI)) Q:BHSI=""  D
  1.  .S BHSJ=$O(BHSITB(BHSI,0))
  1.  .S BHSP=BHSITB(BHSI,BHSJ)
  1.  .S BHSPDN=$P(BHSP,";",1),BHSEDN=$P(BHSP,";",2)
  1.  .D DMAID
  1. MAIDX K BHSCOV,BHSDTL,BHSDTN,BHSDTS,BHSEDN,BHSI,BHSIDN,BHSINS,BHSJ,BHSN,BHSPDN,BHSUFF,Y,BHSXDT,BHSNM,BHSP,BHSQ
  1.  Q
  1. BMAID Q:'$D(^AUPNMCD(BHSPDN))
  1.  S BHSEDN=0 F  S BHSEDN=$O(^AUPNMCD(BHSPDN,11,BHSEDN)) Q:'BHSEDN  D
  1.  .S BHSP=$G(^AUPNMCD(BHSPDN,11,BHSEDN,0))
  1.  .S BHSI=$P(^AUPNMCD(BHSPDN,0),U,4)_"-"_$P(BHSP,U,3)
  1.  .S BHSJ=9999999-$P(BHSP,U,1)
  1.  .S BHSITB(BHSI,BHSJ)=BHSPDN_";"_BHSEDN
  1.  Q
  1. DMAID ;
  1.  N INS,ADDR,PHONE,POLICY
  1.  S BHSNM=$G(^AUPNMCD(BHSPDN,11,BHSEDN,0))
  1.  ;-- add set of exp date variable, quit if not current
  1.  S (BHSXDT,X)=$P(BHSNM,U,2)
  1.  S:BHSXDT="" BHSXDT=9999999
  1.  Q:BHSXDT<$$DT^XLFDT()
  1.  S CNT=CNT+1
  1.  D SET^BADEHL1(.ARY,"IN1",0)
  1.  D SET^BADEHL1(.ARY,CNT,1)
  1.  S BHSN=$G(^AUPNMCD(BHSPDN,0))
  1.  S INSCO=+$P(BHSN,U,2)
  1.  D SET^BADEHL1(.ARY,INSCO,2)    ;Insurer IEN
  1.  D SET^BADEHL1(.ARY,INSCO,3)     ;Insurer IEN
  1.  S BHSINS=$$GET1^DIQ(9999999.18,INSCO,.01)
  1.  S BHSINS=$S($L(BHSINS):BHSINS,1:"???")
  1.  D SET^BADEHL1(.ARY,BHSINS,4)           ;Insurance company name
  1.  ;Get data on the insurer
  1.  S INS=$G(^AUTNINS(INSCO,0))
  1.  D MSCINS
  1.  ;Get the eligibility and expiration dates
  1.  S X=$$HLDATE^HLFNC($P(BHSNM,U,1))
  1.  D SET^BADEHL1(.ARY,X,12)
  1.  S X=$$HLDATE^HLFNC($P(BHSNM,U,2))
  1.  D SET^BADEHL1(.ARY,X,13)
  1.  S X=$$VAL^XBDIQ1(9000004,BHSPDN,.11)
  1.  ;D SET^BADEHL1(.ARY,X,15)         ;Plan type
  1.  ;Name of insured
  1.  S X=$$HLNAME^HLFNC($$GET1^DIQ(9000004,BHSPDN,2101),HLECH) ;was .05
  1.  F LP=1:1:$L(X,$E(HLECH)) S VAL=$P(X,$E(HLECH),LP) D
  1.  .D SET^BADEHL1(.ARY,VAL,16,LP)
  1.  D SET^BADEHL1(.ARY,$$GETREL($P(BHSN,U,6)),17)  ;Relationship to patient
  1.  D SET^BADEHL1(.ARY,$$HLDATE^HLFNC($$GET1^DIQ(9000004,BHSPDN,2102,"I")),18)  ;Medicaid Eligible DOB
  1.  S POLICY=+$P(BHSN,U,9)
  1.  ;Policy Holder's Address
  1.  S POLICY=$G(^AUPN3PPH(POLICY,0))
  1.  I $L(POLICY) D
  1.  .D SET^BADEHL1(.ARY,$P(POLICY,U,9),19,1)  ; Street Address
  1.  .D SET^BADEHL1(.ARY,$P(POLICY,U,11),19,3) ; City
  1.  .S BADEPOLP=$P(POLICY,U,12)  ;SAIC/FJE FIX STATE POINTER 08/22/2011
  1.  .D SET^BADEHL1(.ARY,$$GET1^DIQ(5,$$GET1^DIQ(9000003.1,+BADEPOLP,.12,"I"),1),19,4)  ; State Abbrev
  1.  .D SET^BADEHL1(.ARY,$P(POLICY,U,13),19,5)  ; Zip
  1.  ; IN1-36 is left blank
  1.  D SET^BADEHL1(.ARY,$$GET1^DIQ(9000004,BHSPDN,.07,"I"),43)  ; Gender of Insured
  1.  D SET^BADEHL1(.ARY,$P(BHSNM,U,3),47)  ;Coverage Type
  1.  D SET^BADEHL1(.ARY,$P(BHSN,U,3),49) ; Insured's Medicaid ID number
  1.  S IN1=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  I $D(ERR) D NOTIF^BADEHL1(DFN,"Can't create IN1. "_ERR) ;IHS/MSC/AMF 11/23/10 More descriptive alert
  1.  ;Setup the IN2 segment
  1.  D IN2(INSCO,POLICY,$P(BHSN,U,3))
  1.  Q
  1. MCARE ;ENTRY POINT
  1.  ; See if patient is on MEDICARE
  1.  Q:'$D(^AUPNMCR(DFN))
  1.  S BHSN=$G(^AUPNMCR(DFN,0))
  1.  Q:'$D(^AUPNMCR(DFN,0))
  1.  K BHSITB
  1.  S BHSEDN=0 F  S BHSEDN=$O(^AUPNMCR(DFN,11,BHSEDN)) Q:BHSEDN'=+BHSEDN  D
  1.  .S BHSP=$G(^AUPNMCR(DFN,11,BHSEDN,0))
  1.  .S BHSI=$P(BHSN,U,2)_"-"_$P(BHSP,U,3)
  1.  .S BHSJ=9999999-$P(BHSP,U,1)
  1.  .S BHSITB(BHSI,BHSJ)=DFN_";"_BHSEDN
  1.  S BHSI=0 F BHSQ=0:0 S BHSI=$O(BHSITB(BHSI)) Q:BHSI=""  D
  1.  .S BHSJ=$O(BHSITB(BHSI,0)) S BHSP=BHSITB(BHSI,BHSJ)
  1.  .S BHSPDN=$P(BHSP,";",1),BHSEDN=$P(BHSP,";",2) D DMCARE
  1.  Q
  1. DMCARE ;
  1.  S BHSNM=^AUPNMCR(BHSPDN,11,BHSEDN,0)
  1.  S X=$P(BHSNM,U,1)
  1.  ;--add set of exp date variable, quit if not current
  1.  S (BHSXDT,X)=$P(BHSNM,U,2)
  1.  S:BHSXDT="" BHSXDT=9999999
  1.  Q:BHSXDT<$$DT^XLFDT()
  1.  S CNT=CNT+1
  1.  S BHSUFF=$P(BHSN,U,4) S BHSUFF=$P($G(^AUTTMCS(+BHSUFF,0)),U,1)
  1.  D SET^BADEHL1(.ARY,"IN1",0)
  1.  D SET^BADEHL1(.ARY,CNT,1)
  1.  S BHSN=$G(^AUPNMCR(BHSPDN,0))
  1.  S INSCO=+$P(BHSN,U,2)
  1.  D SET^BADEHL1(.ARY,INSCO,2)     ;Insurer IEN
  1.  D SET^BADEHL1(.ARY,INSCO,3)     ;Insurer IEN
  1.  S BHSINS=$$GET1^DIQ(9999999.18,INSCO,.01)
  1.  S BHSINS=$S($L(BHSINS):BHSINS,1:"???")
  1.  D SET^BADEHL1(.ARY,BHSINS,4)  ;Insurance Company name
  1.  ;Get data on the insurer
  1.  S INS=$G(^AUTNINS(INSCO,0))
  1.  D MSCINS
  1.  ;Get the eligibility and expiration dates
  1.  S X=$$HLDATE^HLFNC($P(BHSNM,U,1))
  1.  D SET^BADEHL1(.ARY,X,12)
  1.  S X=$$HLDATE^HLFNC($P(BHSNM,U,2))
  1.  D SET^BADEHL1(.ARY,X,13)
  1.  ;D SET^BADEHL1(.ARY,$$GET1^DIQ(9000003,DFN,.04),8)  ;Group Number
  1.  ;D SET^BADEHL1(.ARY,$P(BHSNM,U,11),9) ;Group name
  1.  ;D SET^BADEHL1(.ARY,$P(BHSNM,U,3),15) ;Plan type
  1.  S X=$$HLNAME^HLFNC($$GET1^DIQ(9000003,DFN,2101),HLECH)
  1.  F LP=1:1:$L(X,$E(HLECH)) S VAL=$P(X,$E(HLECH),LP) D
  1.  .D SET^BADEHL1(.ARY,VAL,16,LP)
  1.  D SET^BADEHL1(.ARY,"SEL",17)  ;Relationship to patient - File doesn't have .06 field
  1.  D SET^BADEHL1(.ARY,$$HLDATE^HLFNC($$GET1^DIQ(9000003,DFN,2102,"I")),18)  ;Medicare Eligible DOB
  1.  ;No policy so no policy holder address
  1.  D SET^BADEHL1(.ARY,$P(BHSNM,U,8),43)  ; Gender of Insured
  1.  D SET^BADEHL1(.ARY,$P(BHSNM,U,3),47)  ;Coverage Type
  1.  D SET^BADEHL1(.ARY,$P(BHSN,U,3),49)  ; Insured's Medicare ID Number
  1.  S IN1=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  I $D(ERR) D NOTIF^BADEHL1(DFN,"Can't create Medicaid IN1. "_ERR) ;IHS/MSC/AMF 11/23/10 More descriptive alert
  1.  D IN2(INSCO,"")
  1.  K BHSXDT,BHSNM
  1.  Q
  1. THIRD ;EP
  1.  ; OTHER THIRD PARTY
  1.  Q:$O(^AUPNPRVT(DFN,11,0))=""  ; Private Insurance Eligible
  1.  N BHSITB,BHSIDN,BHSP,BHSI,BHSJ
  1.  S BHSIDN=0 F  S BHSIDN=$O(^AUPNPRVT(DFN,11,BHSIDN)) Q:'BHSIDN  D
  1.  .S BHSP=$G(^AUPNPRVT(DFN,11,BHSIDN,0))
  1.  .S BHSITB($P(BHSP,U,1)_"-"_$P(BHSP,U,3),9999999-$P(BHSP,U,6))=BHSIDN
  1.  S BHSI="" F  S BHSI=$O(BHSITB(BHSI)) Q:BHSI=""  D
  1.  .S BHSJ="" F  S BHSJ=$O(BHSITB(BHSI,BHSJ)) Q:BHSJ=""  D
  1.  ..S BHSIDN=BHSITB(BHSI,BHSJ) D DTHIRD
  1.  Q
  1. DTHIRD ;Private insurance data
  1.  N BADEPOLP,INS,ADDR,BHSINS,GRPIEN
  1.  N BHSN,X,BHSXDT,INSCO,POLICY,MEMID
  1.  S (BADEPOLP,INS)=""
  1.  S BHSN=$G(^AUPNPRVT(DFN,11,BHSIDN,0))
  1.  S MEMID=$P($G(^AUPNPRVT(DFN,11,BHSIDN,2)),U)
  1.  S BADEPLCY=$P(BHSN,U,2) ;Policy Number
  1.  S BHSINS=$P($G(^AUTNINS(+$P(BHSN,U,1),0)),U,1)    ;Insurer name
  1.  S BADEPOLP=$P(BHSN,U,8)                      ;policy holder pointer
  1.  ;-- add set of exp date variable, quit if not current
  1.  S (BHSXDT,X)=$P(BHSN,U,7)
  1.  S:BHSXDT="" BHSXDT=9999999
  1.  Q:BHSXDT<$$DT^XLFDT()
  1.  S INSCO=+BHSN
  1.  S CNT=CNT+1
  1.  D SET^BADEHL1(.ARY,"IN1",0)
  1.  D SET^BADEHL1(.ARY,CNT,1)
  1.  D SET^BADEHL1(.ARY,INSCO,2)  ; Insurer IEN
  1.  D SET^BADEHL1(.ARY,INSCO,3)  ; Insurer IEN
  1.  S BHSINS=$$GET1^DIQ(9999999.18,INSCO,.01)
  1.  S BHSINS=$S($L(BHSINS):BHSINS,1:"???")
  1.  D SET^BADEHL1(.ARY,BHSINS,4)               ;Insurance company name
  1.  ;Get data on the insurer
  1.  S INS=$G(^AUTNINS(INSCO,0))
  1.  D MSCINS
  1.  ;
  1.  S POLICY=$G(^AUPN3PPH(+BADEPOLP,0))  ;Policy Node 0
  1.  S GRPIEN=$P(POLICY,U,6)              ; Pointer to Employer Group Insurance
  1.  D SET^BADEHL1(.ARY,$$GET1^DIQ(9999999.77,GRPIEN,.02),8)  ;Group Number
  1.  D SET^BADEHL1(.ARY,$$GET1^DIQ(9999999.77,GRPIEN,.01),9)  ;Group Name
  1.  ;Get the eligibility and expiration dates
  1.  S X=$$HLDATE^HLFNC($P(POLICY,U,17))
  1.  D SET^BADEHL1(.ARY,X,12)
  1.  S X=$$HLDATE^HLFNC($P(POLICY,U,18))
  1.  D SET^BADEHL1(.ARY,X,13)
  1.  ;Name of insured
  1.  S X=$$HLNAME^HLFNC($P(POLICY,U))
  1.  F LP=1:1:$L(X,$E(HLECH)) S VAL=$P(X,$E(HLECH),LP) D
  1.  .D SET^BADEHL1(.ARY,VAL,16,LP)
  1.  ;Relationship to patient
  1.  D SET^BADEHL1(.ARY,$$GETREL($P(BHSN,U,5)),17)
  1.  ;
  1.  S X=$$HLDATE^HLFNC($P(POLICY,U,19))
  1.  D SET^BADEHL1(.ARY,X,18)                ;Insured's DOB
  1.  ;Holder's Address
  1.  D SET^BADEHL1(.ARY,$P(POLICY,U,9),19,1)  ; Street Address
  1.  D SET^BADEHL1(.ARY,$P(POLICY,U,11),19,3) ; City
  1.  D SET^BADEHL1(.ARY,$$GET1^DIQ(5,$$GET1^DIQ(9000003.1,+BADEPOLP,.12,"I"),1),19,4)  ; State Abbrev
  1.  D SET^BADEHL1(.ARY,$P(POLICY,U,13),19,5)  ; Zip
  1.  ;
  1.  D SET^BADEHL1(.ARY,$P(POLICY,U,8),43)  ; Gender of Insured
  1.  I BADEPOLP D
  1.  .;Not Self
  1.  .D SET^BADEHL1(.ARY,MEMID,36) ;Member Number
  1.  .D SET^BADEHL1(.ARY,$P(POLICY,U,4),49)     ;Insured's Member ID number
  1.  E  D
  1.  .;Self
  1.  .D SET^BADEHL1(.ARY,MEMID,36) ;Member Number
  1.  D SET^BADEHL1(.ARY,$$GET1^DIQ(9000003.1,+BADEPOLP,.05),47)  ;Coverage Type
  1.  ;D SET^BADEHL1(.ARY,$P(POLICY,U,4),49)     ;Insured's ID number
  1.  S IN1=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  I $D(ERR) D NOTIF^BADEHL1(DFN,"Can't create IN1. "_ERR) ;IHS/MSC/AMF 11/23/10 More descriptive alert
  1.  ;Do IN2 segment
  1.  D IN2(INSCO,POLICY)
  1.  Q
  1. RR ;EP
  1.  ; RAILROAD RETIREMENT
  1.  Q:'$D(^AUPNRRE(DFN))
  1.  N BHSN,BHSITB,BHSUFF,BHSEDN,BHSP,BHSI,BHSJ,BHSQ,BHSP,BHSPDN
  1.  N BHSNM,BHSPFX,BHSCTYP
  1.  S BHSN=^AUPNRRE(DFN,0)
  1.  ;S BHSINS=$P(^AUTNINS($P(BHSN,U,2),0),U,1)
  1.  ;S BHSUFF=$P(BHSN,U,3)
  1.  S BHSEDN=0 F  S BHSEDN=$O(^AUPNRRE(DFN,11,BHSEDN)) Q:BHSEDN'=+BHSEDN  D
  1.  .S BHSP=$G(^AUPNRRE(DFN,11,BHSEDN,0))
  1.  .S BHSI=$P(BHSN,U,2)_"-"_$P(BHSP,U,3),BHSJ=9999999-$P(BHSP,U,1)
  1.  .S BHSITB(BHSI,BHSJ)=DFN_";"_BHSEDN
  1.  S BHSI=0 F BHSQ=0:0 S BHSI=$O(BHSITB(BHSI)) Q:BHSI=""  D
  1.  .S BHSJ=$O(BHSITB(BHSI,0)) S BHSP=BHSITB(BHSI,BHSJ)
  1.  .S BHSPDN=$P(BHSP,";",1),BHSEDN=$P(BHSP,";",2) D DRR
  1.  Q
  1. DRR ;
  1.  N X,BHSXDT,BHSINS
  1.  S BHSNM=^AUPNRRE(BHSPDN,11,BHSEDN,0)
  1.  S X=$P(BHSNM,U,1)
  1.  ;-- add set of exp date variable, quit if not current
  1.  S (BHSXDT,X)=$P(BHSNM,U,2)
  1.  S:BHSXDT="" BHSXDT=9999999
  1.  Q:BHSXDT<$$DT^XLFDT()
  1.  S CNT=CNT+1
  1.  D SET^BADEHL1(.ARY,"IN1",0)
  1.  D SET^BADEHL1(.ARY,CNT,1)
  1.  S BHSN=^AUPNRRE(DFN,0)
  1.  S INSCO=+$P(BHSN,U,2)
  1.  S BHSPFX=$$GET1^DIQ(9000005,DFN,.03)    ; Prefix
  1.  S BHSCTYP=$P(BHSNM,U,3)  ; Coverage Type
  1.  D SET^BADEHL1(.ARY,INSCO,2)     ; Insurer IEN
  1.  D SET^BADEHL1(.ARY,INSCO,3)     ; Insurer IEN
  1.  S BHSINS=$$GET1^DIQ(9999999.18,INSCO,.01)
  1.  S BHSINS=$S($L(BHSINS):BHSINS,1:"???")
  1.  D SET^BADEHL1(.ARY,BHSINS,4)  ;Insurance Company name
  1.  ;Get data on the insurer
  1.  S INS=$G(^AUTNINS(INSCO,0))
  1.  D MSCINS
  1.  ;Get the eligibility and expiration dates
  1.  S X=$$HLDATE^HLFNC($P(BHSNM,U,1))
  1.  D SET^BADEHL1(.ARY,X,12)
  1.  S X=$$HLDATE^HLFNC($P(BHSNM,U,2))
  1.  D SET^BADEHL1(.ARY,X,13)
  1.  D SET^BADEHL1(.ARY,$$GET1^DIQ(9000005,DFN,.04),8)  ;Group Number
  1.  S X=$$HLNAME^HLFNC($$GET1^DIQ(9000005,DFN,2101),HLECH)  ;Name of insured
  1.  F LP=1:1:$L(X,$E(HLECH)) S VAL=$P(X,$E(HLECH),LP) D
  1.  .D SET^BADEHL1(.ARY,VAL,16,LP)
  1.  D SET^BADEHL1(.ARY,"SEL",17)  ;Relationship to patient - File doesn't have .06 field
  1.  D SET^BADEHL1(.ARY,$$HLDATE^HLFNC($P(BHSNM,U,9)),18)  ;Insured's DOB
  1.  D SET^BADEHL1(.ARY,$$HLDATE^HLFNC($$GET1^DIQ(9000005,DFN,2102,"I")),18)
  1.  ;Insured's address
  1.  ; No policy so no policy holder address
  1.  ;S FLD=$$PTADDR(DFN)
  1.  ;F LP=1:1:$L(FLD,$E(HLECH)) S VAL=$P(FLD,$E(HLECH),LP) D
  1.  ;.D SET^BADEHL1(.ARY,VAL,19,LP)
  1.  ;D SET^BADEHL1(.ARY,$P(BHSN,U,4),36) ;policy number
  1.  D SET^BADEHL1(.ARY,$P(BHSNM,U,8),43)  ; Gender of Insured
  1.  D SET^BADEHL1(.ARY,$P(BHSNM,U,3),47)  ; Coverage Type
  1.  D SET^BADEHL1(.ARY,$S(BHSCTYP="D":$P(BHSNM,U,6),1:BHSPFX_$P(BHSN,U,4)),49)  ; ID Number
  1.  S IN1=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  I $D(ERR) D NOTIF^BADEHL1(DFN,"Can't create Railroad IN1. "_ERR) ;IHS/MSC/AMF 11/23/10 More descriptive alert
  1.  ;Setup the IN2 segment
  1.  D IN2(INSCO,"")
  1.  K BHSNM,BHSXDT
  1.  Q
  1. MSCINS ;Insurance company data
  1.  Q:'$L(INS)
  1.  N ST,ZIP,ADDR,LP,VAL,PHONE,PHD
  1.  S ST=$$GET1^DIQ(5,$P(INS,U,4),1)   ;State Abbrev
  1.  S ZIP=$E($P(INS,U,5),1,5)
  1.  S ADDR=$P(INS,U,2)_"^^"_$P(INS,U,3)_"^"_ST_"^"_ZIP
  1.  F LP=1:1:$L(ADDR,$E(HLECH)) S VAL=$P(ADDR,$E(HLECH),LP) D
  1.  .D SET^BADEHL1(.ARY,VAL,5,LP)
  1.  S PHD=$P(BHSN,U,9)  ;Company Contact Name
  1.  S PHD=$$HLNAME^HLFNC($$GET1^DIQ(9000003.1,PHD,.01),HLECH)
  1.  F LP=1:1:$L(PHD,$E(HLECH)) S VAL=$P(PHD,$E(HLECH),LP) D
  1.  .D SET^BADEHL1(.ARY,VAL,6,LP)
  1.  S PHONE=$$HLPHONE^HLFNC($P(INS,U,6))
  1.  I $L(PHONE) D
  1.  .D SET^BADEHL1(.ARY,PHONE,7,1)  ;Company Phone Number
  1.  .D SET^BADEHL1(.ARY,"WPH",7,2)
  1.  Q
  1. GETREL(RIEN) ;Find the relationship
  1.  N Y,REL
  1.  S REL=""
  1.  I +RIEN D
  1.  .S Y=$$GET1^DIQ(9999999.36,RIEN,.01)
  1.  .I Y="SPOUSE"!(Y="HUSBAND")!(Y="WIFE")!(Y="LIFE PARTNER") S REL="SPO"
  1.  .E  I Y="SELF" S REL="SEL"
  1.  .E  I Y="SON"!(Y="DAUGHTER")!(Y="CHILD")!(Y="STEPSON")!(Y="STEPDAUGHTER")!(Y="STEP CHILD") S REL="CHD"
  1.  .E  S REL="OTH"
  1.  Q REL
  1. IN2(INSCO,POLICY,CASENUM) ;Do the IN2 Segment
  1.  N BADEEMPP,BADEEMPN,BADEPPAT,DEN,DENI
  1.  S CASENUM=$G(CASENUM,"")
  1.  D SET^BADEHL1(.ARY,"IN2",0)
  1.  D SET^BADEHL1(.ARY,CNT,1)
  1.  D SET^BADEHL1(.ARY,CASENUM,8)  ; Medicaid Case Number
  1.  I POLICY'="" D
  1.  .S BADEEMPP=$P(POLICY,U,16)
  1.  .I BADEEMPP'="" D
  1.  ..S BADEEMPN=$P($G(^AUTNEMPL(+BADEEMPP,0)),U,1)  ;Employer name
  1.  ..S X=BADEEMPP_"^"_BADEEMPN
  1.  ..F LP=1:1:$L(X,$E(HLECH)) S VAL=$P(X,$E(HLECH),LP) D
  1.  ...D SET^BADEHL1(.ARY,VAL,3,LP)
  1.  S DEN=$P($G(^AUTNINS(+INSCO,2)),U,5)
  1.  I DEN="U"!(DEN="") S DENI="MD"
  1.  E  S DENI="DN"
  1.  D SET^BADEHL1(.ARY,DENI,59)
  1.  S IN2=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  I $D(ERR) D NOTIF^BADEHL1(DFN,"Can't create IN2. "_ERR) ;IHS/MSC/AMF 11/23/10 More descriptive alert
  1.  Q
  1.  ;
  1. CRTNULL ; Creates empty IN1/IN2
  1.  D SET^BADEHL1(.ARY,"IN1",0)
  1.  D SET^BADEHL1(.ARY,1,1)
  1.  S IN1=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  I $D(ERR) D NOTIF^BADEHL1(DFN,"Can't create IN1. "_ERR) Q  ;IHS/MSC/AMF 11/23/10 More descriptive alert
  1.  D SET^BADEHL1(.ARY,"IN2",0)
  1.  D SET^BADEHL1(.ARY,1,1)
  1.  S IN2=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  I $D(ERR) D NOTIF^BADEHL1(DFN,"Can't create IN2. "_ERR) Q  ;IHS/MSC/AMF 11/23/10 More descriptive alert
  1.  Q
  1.  ; Return HL7 formed patient address
  1. PTADDR(DFN) ;EP
  1.  N HLQ,FLD,PID
  1.  S HLQ=HL1("Q")
  1.  S PID=$$EN^VAFHLPID(DFN,"11")
  1.  S FLD=$P(PID,HLFS,12)
  1.  Q FLD