BAR276.m

BAR276 ; IHS/SD/LSL - A/R EDI 276 SETUP ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 ;

 ; Original routine created by cmi/flag/maw - V1.6 Patch 3

 ;

 ; ********************************************************************

 ;

 ; E.g. (msm) : 

 ;       KILL A S A="" D GEN276^BAR276(D) ZW A

 ;       where:  D = IEN of the of the Status File

 ;

GEN276(BARSIEN) ;

 ; DUZ(2) must exist.

 ; BARSIEN = IEN of the Bill.

 ;

 S BARBIEN=$P($G(^BARECLST(BARSIEN,0)),U,2)

 ;S BARBIEN=2737  ;maw test

 S BARDUZ2=$P($G(^BARECLST(BARSIEN,0)),U,3)

 ;S BARDUZ2=1575  ;maw test

 ;

ST ;TRANSACTION SET HEADER

 ; ST01

 S BAR("276HFST1")=276

 ; ST02

 ;S BAR("276HFST2")="0001"  ;make this unique maw

 ;

BHT ;BEGINNING OF HIERARCHICAL TRANSACTION

 ; BHT01

 S BAR("276HFBHT1")="0010"

 ; BHT02

 S BAR("276HFBHT2")="13"

 ; BHT03

 ;S BAR("276HFBHT3")=$TR($$TS_BARSIEN,"-")  not used

 ; BHT04

 S BAR("276HFBHT4")=$E($$TS,1,8)

 ; BHT05

 ;S BAR("276HFBHT5")=$E($$TS,9,12)  not used

 ;

 ;2000A INFORMATION SOURCE LEVEL

 ; HL01

 S BAR("2762000AHL1")=1

 ; HL02

 ; HL03

 S BAR("2762000AHL3")=20

 ; HL04

 S BAR("2762000AHL4")=1

 ;

 ;2100A PAYER NAME

 ; NM101

 S BAR("2762100ANM11")="PR"

 ; NM102

 S BAR("2762100ANM12")=2

 ; NM103

 S BAR("PAYER")=$$GET1^DIQ(90050.01,BARBIEN_","_BARDUZ2_",",3)

 S BAR("2762100ANM13")=BAR("PAYER")

 ; NM104

 ; NM105

 ; NM106

 ; NM107

 ; NM108

 S BAR("2762100ANM18")="NI"

 ; NM109

 S BAR("INS IEN")=$$INSIEN^BARUTL("BILL",BARBIEN,BARDUZ2)

 I $G(BAR("INS IEN")) D

 . S BAR("2762100ANM19")=$$RCID^ABMERUTL(BAR("INS IEN"))

 ;

 ;2100A PAYER CONTACT INFO

 ; PER01n/a

 ; PER02n/a

 ; PER03n/a

 ; PER04n/a

 ; PER05n/a

 ; PER06n/a

 ; PER07n/a

 ; PER08n/a

 ;

 ;2000B INFORMATION RECEIVER LEVEL

 ; HL01

 S BAR("2762000BHL1")=2

 ; HL02

 S BAR("2762000BHL2")=1

 ; HL03

 S BAR("2762000BHL3")=21

 ; HL04

 S BAR("2762000BHL4")=1

 ;

 ;2010B INFORMATION RECEIVER NAME

 ; NM101

 S BAR("2762100BNM11")="41"  ;gis

 ; NM102

 S BAR("2762100BNM12")="2"  ;gis

 ; NM103

 S BAR("2762100BNM13")=$P($G(^DIC(4,BARDUZ2,0)),U)  ;gis

 ; NM104

 ; NM105

 ; NM106

 ; NM107

 ; NM108

 S BAR("2762100BNM18")="FI"  ;gis

 ; NM109

 S BAR("2762100BNM19")=$$GET1^DIQ(9999999.06,BARDUZ2,.21)  ;gis

 ;

 ;2000C SERVICE PROVIDER LEVEL

 ; HL01

 S BAR("2762000CHL1")=3

 ; HL02

 S BAR("2762000CHL2")=2

 ; HL03

 S BAR("2762000CHL3")=19

 ; HL04

 S BAR("2762000CHL4")=1

 ;

 ;2100C PROVIDER NAME

 ; NM101

 S BAR("2762100CNM11")="1P"  ;gis

 ; NM102

 S BAR("2762100CNM12")="2"  ;gis

 ; NM103

 S BAR("2762100CNM13")=$P($G(^DIC(4,BARDUZ2,0)),U)  ;gis

 ; NM104n/a

 ; NM105n/a

 ; NM106n/a

 ; NM107n/a

 ; NM108

 S BAR("2762100CNM18")="FI"  ;gis

 ; NM109

 S BAR("2762100CNM19")=$$GET1^DIQ(9999999.06,BARDUZ2,.21)  ;gis

 ;

 ;2000D SUBSCRIBER LEVEL

 ;

 D SBR^BARUTL(BARDUZ2,BARBIEN)

 ;

 ; HL01

SBR ;

 S BAR("2762000DHL1")=4

 ; HL02

 S BAR("2762000DHL2")=3

 ; HL03

 S BAR("2762000DHL3")=22

 ; HL04

 S BAR("2762000DHL4")=$S($G(BARREL)=18:0,1:1)

 ;

 ;2000D SUBSCRIBER DEMPGRAPHIC INFO

 ; DMG01

 I $G(BARREL)=18 S BAR("2762000DDMG1")="D8"

 ; DMG02

 I $G(BARREL)=18 D

 . S BAR("2762000DDMG2")=$$DOB^ABMUTLN($P(ABMSBR,"-"),$P(ABMSBR,"-",2))

 I $G(BAR("2762000DDMG2")) D

 . S BAR("2762000DDMG2")=$$Y2KD2^BARDUTL(BAR("2762000DDMG2"))

 ; DMG03

 I $G(BARREL)=18 D

 . S BAR("2762000DDMG3")=$$SEX^ABMUTLN($P(ABMSBR,"-"),$P(ABMSBR,"-",2))

 I $G(BAR("2762000DDMG3"))="" D

 . Q:$G(BARREL)'=18

 . S BAR("2762000DDMG3")="U"

 ;

 ;2100D SUBSCRIBER NAME

 ; NM101

 S BAR("2762100DNM11")=$S($G(BARREL)=18:"QC",1:"IL")  ;gis

 ; NM102

 S BAR("2762100DNM12")="1"  ;gis

 ; NM103

 I $G(BARREL)=18 D

 . S BARFILE=2,BARPIEN=$G(ABMPDFN)

 I $G(BARREL)'=18 D

 . S BARFILE=$P(ABMSBR,"-"),BARPIEN=$P(ABMSBR,"-",2)

 S BAR("2762100DNM13")=$$LNM^ABMUTLN(BARFILE,BARPIEN)  ;gis

 ; NM104

 S BAR("2762100DNM14")=$$FNM^ABMUTLN(BARFILE,BARPIEN)  ;gis

 ; NM105

 S BAR("2762100DNM15")=$$MI^ABMUTLN(BARFILE,BARPIEN)

 ; NM106n/a

 ; NM107

 S BAR("2762100DNM17")=$$SFX^ABMUTLN(BARFILE,BARPIEN)

 ; NM108

 S BAR("2762100DNM18")="MI"

 ; NM109

 S BAR("2762100DNM19")=$G(ABMP("SNUM"))

 ;

 ;

 ;2200D CLAIM SUBMITTER TRACE NUMBER

 ; TRN01

 S BAR("2762200DTRN1")=1

 ; TRN02

 S BAR("2762200DTRN2")=$G(BARSIEN)

 ;

 ;2200D PAYER CLAIM ID NUMBER

 ; REF01

 I $G(BARREL)=18 S BAR("2762200DREFA1")="1K"

 ; REF02

 I $G(BARREL)=18 D

 . S BAR("2762200DREFA2")=$P($G(^BARBL(BARDUZ2,BARBIEN,0)),U)

 ;

 ;2200D INSTITUTIONAL BILL TYPE ID

 ; REF01

 I $G(BARREL)=18 S BAR("2762200DREFB1")="BLT"

 ; REF02

 I $G(BARREL)=18 D

 . S BAR("2762200DREFB2")=$G(ABMP("BTYP"))

 ;

 ;2200D MEDICAL RECORD ID

 ; REF01

 I $G(BARREL)=18 S BAR("2762200DREFC1")="EA"

 ; REF02

 I $G(BARREL)=18 D

 . S BAR("VISIT LOC")=$P($G(^BARBL(BARDUZ2,BARBIEN,1)),U,8)

 . I $G(BAR("VISIT LOC")) S BAR("SUB CHART")=$P($G(^AUPNPAT(ABMP("PDFN"),41,BAR("VISIT LOC"),0)),U,2)

 . S BAR("2762200DREFC2")=$G(BAR("SUB CHART"))

 ;

 ;2200D CLAIM SUBMITTED CHARGES

 ; AMT01

 I $G(BARREL)=18 S BAR("2762200DAMT1")="T3"

 ; AMT02

 I $G(BARREL)=18 D

 . S BAR("2762200DAMT2")=$P($G(^BARBL(BARDUZ2,BARBIEN,0)),U,13)

 ; AMT03n/a

 ;

 ;

 ;2200D CLAIM SERVICE DATE

 ; DTP01

 I $G(BARREL)=18 S BAR("2762200DDTP1")=232

 ; DTP02

 I $G(BARREL)=18 S BAR("2762200DDTP2")="RD8"

 ; DTP03

 I $G(BARREL)=18 D

 . S BAR("DOS BEG")=$$Y2KD2^BARDUTL($P($G(^BARBL(BARDUZ2,BARBIEN,1)),U,2))

 . S BAR("DOS END")=$$Y2KD2^BARDUTL($P($G(^BARBL(BARDUZ2,BARBIEN,1)),U,3))

 . S BAR("2762200DDTP3")=BAR("DOS BEG")_"-"_BAR("DOS END")

 ;

 ;2210D SERVICE LINE INFORMATION

 ; SVC01n/A

 ; SVC02n/A

 ; SVC03n/A

 ; SVC04n/A

 ; SVC05n/A

 ; SVC06n/A

 ; SVC07n/A

 ;

 ;2210D SERVICE LINE ITEM ID

 ; REF01n/a

 ; REF02n/a

 ;

 ;2210D SERVICE LINE DATE

 ; DTP01n/a

 ; DTP02n/a

 ; DTP03n/a

 ;

DEP ;2000E DEPENDENT LEVEL

 Q:$G(BARREL)=18

 ; HL01

 S BAR("2762000EHL1")=5

 ; HL02

 S BAR("2762000EHL2")=4

 ; HL03

 S BAR("2762000EHL3")=23

 ; HL04

 ;S BAR("2762000EHL4")=""  not used

 ;

 ;2000E DEPENDENT DEMPGRAPHIC INFO

 ; DMG01

 S BAR("2762000EDMG1")="D8"

 ; DMG02

 S BAR("2762000EDMG2")=$$DOB^ABMUTLN($P(ABMSBR,"-"),$P(ABMSBR,"-",2))

 I $G(BAR("2762000EDMG2")) D

 . S BAR("2762000EDMG2")=$$Y2KD2^BARDUTL(BAR("2762000EDMG2"))

 ; DMG03

 S BAR("2762000EDMG3")=$$SEX^ABMUTLN($P(ABMSBR,"-"),$P(ABMSBR,"-",2))

 I $G(BAR("2762000EDMG3"))="" S BAR("2762000EDMG3")="U"

 ;

 ;2100E DEPENDENT NAME

 ; NM101

 S BAR("2762100ENM11")="QC"  ;gis

 ; NM102

 S BAR("2762100ENM12")="1"  ;gis

 ; NM103

 S BARFILE=$P(ABMSBR,"-"),BARPIEN=$P(ABMSBR,"-",2)

 S BAR("2762100ENM13")=$$LNM^ABMUTLN(BARFILE,BARPIEN)  ;gis

 ; NM104

 S BAR("2762100ENM14")=$$FNM^ABMUTLN(BARFILE,BARPIEN)  ;gis

 ; NM105

 S BAR("2762100ENM15")=$$MI^ABMUTLN(BARFILE,BARPIEN)

 ; NM106n/a

 ; NM107

 S BAR("2762100ENM17")=$$SFX^ABMUTLN(BARFILE,BARPIEN)

 ; NM108

 S BAR("2762100ENM18")="MI"

 ; NM109

 S BAR("2762100ENM19")=$G(ABMP("PNUM"))

 ;

 ;

 ;2200E CLAIM SUBMITTER TRACE NUMBER

 ; TRN01

 S BAR("2762200ETRN1")=1

 ; TRN02

 S BAR("2762200ETRN2")=$G(BARSIEN)

 ;

 ;2200E PAYER CLAIM ID NUMBER

 ; REF01

 S BAR("2762200EREFA1")="1K"

 ; REF02

 S BAR("2762200EREFA2")=$P($G(^BARBL(BARDUZ2,BARBIEN,0)),U)

 ;

 ;2200E INSTITUTIONAL BILL TYPE ID

 ; REF01

 S BAR("2762200EREFB1")="BLT"

 ; REF02

 S BAR("2762200EREFB2")=$G(ABMP("BTYP"))

 ;

 ;2200E MEDICAL RECORD ID

 ; REF01

 S BAR("2762200EREFC1")="EA"

 ; REF02

 S BAR("VISIT LOC")=$P($G(^BARBL(BARDUZ2,BARBIEN,1)),U,8)

 I $G(BAR("VISIT LOC")) S BAR("DEP CHART")=$P($G(^AUPNPAT(ABMP("PDFN"),41,BAR("VISIT LOC"),0)),U,2)

 S BAR("2762200EREFC2")=$G(BAR("DEP CHART"))

 ;

 ;2200E CLAIM SUBMITTED CHARGES

 ; AMT01

 S BAR("2762200EAMT1")="T3"

 ; AMT02

 S BAR("2762200EAMT2")=$P($G(^BARBL(BARDUZ2,BARBIEN,0)),U,13)

 ; AMT03n/a

 ;

 ;

 ;2200E CLAIM SERVICE DATE

 ; DTP01

 S BAR("2762200EDTP1")=232

 ; DTP02

 S BAR("2762200EDTP2")="RD8"

 ; DTP03

 S BAR("DOS BEG")=$$Y2KD2^BARDUTL($P($G(^BARBL(BARDUZ2,BARBIEN,1)),U,2))

 S BAR("DOS END")=$$Y2KD2^BARDUTL($P($G(^BARBL(BARDUZ2,BARBIEN,1)),U,3))

 S BAR("2762200EDTP3")=BAR("DOS BEG")_"-"_BAR("DOS END")

 ;

 ;2210D SERVICE LINE INFORMATION

 ; SVC01n/A

 ; SVC02n/A

 ; SVC03n/A

 ; SVC04n/A

 ; SVC05n/A

 ; SVC06n/A

 ; SVC07n/A

 ;

 ;2210D SERVICE LINE ITEM ID

 ; REF01n/a

 ; REF02n/a

 ;

 ;2210D SERVICE LINE DATE

 ; DTP01n/a

 ; DTP02n/a

 ; DTP03n/a

 ;

GIS ;-- make the gis call

 S BARMSG=$$276^BHLEVENT(BARSIEN,.BAR)

 Q

 ;

TS() ;-- make a time stamp

 D NOW^%DTC

 Q $$TS^INHUT1(%)

 ;

BAR276    ; IHS/SD/LSL - A/R EDI 276 SETUP ;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 +2       ;

 +3       ; Original routine created by cmi/flag/maw - V1.6 Patch 3

 +4       ;

 +5       ; ********************************************************************

 +6       ;

 +7       ; E.g. (msm) : 

 +8       ;       KILL A S A="" D GEN276^BAR276(D) ZW A

 +9       ;       where:  D = IEN of the of the Status File

 +10      ;

GEN276(BARSIEN) ;

 +1       ; DUZ(2) must exist.

 +2       ; BARSIEN = IEN of the Bill.

 +3       ;

 +4        SET BARBIEN=$PIECE($GET(^BARECLST(BARSIEN,0)),U,2)

 +5       ;S BARBIEN=2737  ;maw test

 +6        SET BARDUZ2=$PIECE($GET(^BARECLST(BARSIEN,0)),U,3)

 +7       ;S BARDUZ2=1575  ;maw test

 +8       ;

ST        ;TRANSACTION SET HEADER

 +1       ; ST01

 +2        SET BAR("276HFST1")=276

 +3       ; ST02

 +4       ;S BAR("276HFST2")="0001"  ;make this unique maw

 +5       ;

BHT       ;BEGINNING OF HIERARCHICAL TRANSACTION

 +1       ; BHT01

 +2        SET BAR("276HFBHT1")="0010"

 +3       ; BHT02

 +4        SET BAR("276HFBHT2")="13"

 +5       ; BHT03

 +6       ;S BAR("276HFBHT3")=$TR($$TS_BARSIEN,"-")  not used

 +7       ; BHT04

 +8        SET BAR("276HFBHT4")=$EXTRACT($$TS,1,8)

 +9       ; BHT05

 +10      ;S BAR("276HFBHT5")=$E($$TS,9,12)  not used

 +11      ;

 +12      ;2000A INFORMATION SOURCE LEVEL

 +13      ; HL01

 +14       SET BAR("2762000AHL1")=1

 +15      ; HL02

 +16      ; HL03

 +17       SET BAR("2762000AHL3")=20

 +18      ; HL04

 +19       SET BAR("2762000AHL4")=1

 +20      ;

 +21      ;2100A PAYER NAME

 +22      ; NM101

 +23       SET BAR("2762100ANM11")="PR"

 +24      ; NM102

 +25       SET BAR("2762100ANM12")=2

 +26      ; NM103

 +27       SET BAR("PAYER")=$$GET1^DIQ(90050.01,BARBIEN_","_BARDUZ2_",",3)

 +28       SET BAR("2762100ANM13")=BAR("PAYER")

 +29      ; NM104

 +30      ; NM105

 +31      ; NM106

 +32      ; NM107

 +33      ; NM108

 +34       SET BAR("2762100ANM18")="NI"

 +35      ; NM109

 +36       SET BAR("INS IEN")=$$INSIEN^BARUTL("BILL",BARBIEN,BARDUZ2)

 +37       IF $GET(BAR("INS IEN"))

               Begin DoDot:1

 +38               SET BAR("2762100ANM19")=$$RCID^ABMERUTL(BAR("INS IEN"))

               End DoDot:1

 +39      ;

 +40      ;2100A PAYER CONTACT INFO

 +41      ; PER01n/a

 +42      ; PER02n/a

 +43      ; PER03n/a

 +44      ; PER04n/a

 +45      ; PER05n/a

 +46      ; PER06n/a

 +47      ; PER07n/a

 +48      ; PER08n/a

 +49      ;

 +50      ;2000B INFORMATION RECEIVER LEVEL

 +51      ; HL01

 +52       SET BAR("2762000BHL1")=2

 +53      ; HL02

 +54       SET BAR("2762000BHL2")=1

 +55      ; HL03

 +56       SET BAR("2762000BHL3")=21

 +57      ; HL04

 +58       SET BAR("2762000BHL4")=1

 +59      ;

 +60      ;2010B INFORMATION RECEIVER NAME

 +61      ; NM101

 +62      ;gis

           SET BAR("2762100BNM11")="41"

 +63      ; NM102

 +64      ;gis

           SET BAR("2762100BNM12")="2"

 +65      ; NM103

 +66      ;gis

           SET BAR("2762100BNM13")=$PIECE($GET(^DIC(4,BARDUZ2,0)),U)

 +67      ; NM104

 +68      ; NM105

 +69      ; NM106

 +70      ; NM107

 +71      ; NM108

 +72      ;gis

           SET BAR("2762100BNM18")="FI"

 +73      ; NM109

 +74      ;gis

           SET BAR("2762100BNM19")=$$GET1^DIQ(9999999.06,BARDUZ2,.21)

 +75      ;

 +76      ;2000C SERVICE PROVIDER LEVEL

 +77      ; HL01

 +78       SET BAR("2762000CHL1")=3

 +79      ; HL02

 +80       SET BAR("2762000CHL2")=2

 +81      ; HL03

 +82       SET BAR("2762000CHL3")=19

 +83      ; HL04

 +84       SET BAR("2762000CHL4")=1

 +85      ;

 +86      ;2100C PROVIDER NAME

 +87      ; NM101

 +88      ;gis

           SET BAR("2762100CNM11")="1P"

 +89      ; NM102

 +90      ;gis

           SET BAR("2762100CNM12")="2"

 +91      ; NM103

 +92      ;gis

           SET BAR("2762100CNM13")=$PIECE($GET(^DIC(4,BARDUZ2,0)),U)

 +93      ; NM104n/a

 +94      ; NM105n/a

 +95      ; NM106n/a

 +96      ; NM107n/a

 +97      ; NM108

 +98      ;gis

           SET BAR("2762100CNM18")="FI"

 +99      ; NM109

 +100     ;gis

           SET BAR("2762100CNM19")=$$GET1^DIQ(9999999.06,BARDUZ2,.21)

 +101     ;

 +102     ;2000D SUBSCRIBER LEVEL

 +103     ;

 +104      DO SBR^BARUTL(BARDUZ2,BARBIEN)

 +105     ;

 +106     ; HL01

SBR       ;

 +1        SET BAR("2762000DHL1")=4

 +2       ; HL02

 +3        SET BAR("2762000DHL2")=3

 +4       ; HL03

 +5        SET BAR("2762000DHL3")=22

 +6       ; HL04

 +7        SET BAR("2762000DHL4")=$SELECT($GET(BARREL)=18:0,1:1)

 +8       ;

 +9       ;2000D SUBSCRIBER DEMPGRAPHIC INFO

 +10      ; DMG01

 +11       IF $GET(BARREL)=18

               SET BAR("2762000DDMG1")="D8"

 +12      ; DMG02

 +13       IF $GET(BARREL)=18

               Begin DoDot:1

 +14               SET BAR("2762000DDMG2")=$$DOB^ABMUTLN($PIECE(ABMSBR,"-"),$PIECE(ABMSBR,"-",2))

               End DoDot:1

 +15       IF $GET(BAR("2762000DDMG2"))

               Begin DoDot:1

 +16               SET BAR("2762000DDMG2")=$$Y2KD2^BARDUTL(BAR("2762000DDMG2"))

               End DoDot:1

 +17      ; DMG03

 +18       IF $GET(BARREL)=18

               Begin DoDot:1

 +19               SET BAR("2762000DDMG3")=$$SEX^ABMUTLN($PIECE(ABMSBR,"-"),$PIECE(ABMSBR,"-",2))

               End DoDot:1

 +20       IF $GET(BAR("2762000DDMG3"))=""

               Begin DoDot:1

 +21               IF $GET(BARREL)'=18

                       QUIT 

 +22               SET BAR("2762000DDMG3")="U"

               End DoDot:1

 +23      ;

 +24      ;2100D SUBSCRIBER NAME

 +25      ; NM101

 +26      ;gis

           SET BAR("2762100DNM11")=$SELECT($GET(BARREL)=18:"QC",1:"IL")

 +27      ; NM102

 +28      ;gis

           SET BAR("2762100DNM12")="1"

 +29      ; NM103

 +30       IF $GET(BARREL)=18

               Begin DoDot:1

 +31               SET BARFILE=2

                   SET BARPIEN=$GET(ABMPDFN)

               End DoDot:1

 +32       IF $GET(BARREL)'=18

               Begin DoDot:1

 +33               SET BARFILE=$PIECE(ABMSBR,"-")

                   SET BARPIEN=$PIECE(ABMSBR,"-",2)

               End DoDot:1

 +34      ;gis

           SET BAR("2762100DNM13")=$$LNM^ABMUTLN(BARFILE,BARPIEN)

 +35      ; NM104

 +36      ;gis

           SET BAR("2762100DNM14")=$$FNM^ABMUTLN(BARFILE,BARPIEN)

 +37      ; NM105

 +38       SET BAR("2762100DNM15")=$$MI^ABMUTLN(BARFILE,BARPIEN)

 +39      ; NM106n/a

 +40      ; NM107

 +41       SET BAR("2762100DNM17")=$$SFX^ABMUTLN(BARFILE,BARPIEN)

 +42      ; NM108

 +43       SET BAR("2762100DNM18")="MI"

 +44      ; NM109

 +45       SET BAR("2762100DNM19")=$GET(ABMP("SNUM"))

 +46      ;

 +47      ;

 +48      ;2200D CLAIM SUBMITTER TRACE NUMBER

 +49      ; TRN01

 +50       SET BAR("2762200DTRN1")=1

 +51      ; TRN02

 +52       SET BAR("2762200DTRN2")=$GET(BARSIEN)

 +53      ;

 +54      ;2200D PAYER CLAIM ID NUMBER

 +55      ; REF01

 +56       IF $GET(BARREL)=18

               SET BAR("2762200DREFA1")="1K"

 +57      ; REF02

 +58       IF $GET(BARREL)=18

               Begin DoDot:1

 +59               SET BAR("2762200DREFA2")=$PIECE($GET(^BARBL(BARDUZ2,BARBIEN,0)),U)

               End DoDot:1

 +60      ;

 +61      ;2200D INSTITUTIONAL BILL TYPE ID

 +62      ; REF01

 +63       IF $GET(BARREL)=18

               SET BAR("2762200DREFB1")="BLT"

 +64      ; REF02

 +65       IF $GET(BARREL)=18

               Begin DoDot:1

 +66               SET BAR("2762200DREFB2")=$GET(ABMP("BTYP"))

               End DoDot:1

 +67      ;

 +68      ;2200D MEDICAL RECORD ID

 +69      ; REF01

 +70       IF $GET(BARREL)=18

               SET BAR("2762200DREFC1")="EA"

 +71      ; REF02

 +72       IF $GET(BARREL)=18

               Begin DoDot:1

 +73               SET BAR("VISIT LOC")=$PIECE($GET(^BARBL(BARDUZ2,BARBIEN,1)),U,8)

 +74               IF $GET(BAR("VISIT LOC"))

                       SET BAR("SUB CHART")=$PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,BAR("VISIT LOC"),0)),U,2)

 +75               SET BAR("2762200DREFC2")=$GET(BAR("SUB CHART"))

               End DoDot:1

 +76      ;

 +77      ;2200D CLAIM SUBMITTED CHARGES

 +78      ; AMT01

 +79       IF $GET(BARREL)=18

               SET BAR("2762200DAMT1")="T3"

 +80      ; AMT02

 +81       IF $GET(BARREL)=18

               Begin DoDot:1

 +82               SET BAR("2762200DAMT2")=$PIECE($GET(^BARBL(BARDUZ2,BARBIEN,0)),U,13)

               End DoDot:1

 +83      ; AMT03n/a

 +84      ;

 +85      ;

 +86      ;2200D CLAIM SERVICE DATE

 +87      ; DTP01

 +88       IF $GET(BARREL)=18

               SET BAR("2762200DDTP1")=232

 +89      ; DTP02

 +90       IF $GET(BARREL)=18

               SET BAR("2762200DDTP2")="RD8"

 +91      ; DTP03

 +92       IF $GET(BARREL)=18

               Begin DoDot:1

 +93               SET BAR("DOS BEG")=$$Y2KD2^BARDUTL($PIECE($GET(^BARBL(BARDUZ2,BARBIEN,1)),U,2))

 +94               SET BAR("DOS END")=$$Y2KD2^BARDUTL($PIECE($GET(^BARBL(BARDUZ2,BARBIEN,1)),U,3))

 +95               SET BAR("2762200DDTP3")=BAR("DOS BEG")_"-"_BAR("DOS END")

               End DoDot:1

 +96      ;

 +97      ;2210D SERVICE LINE INFORMATION

 +98      ; SVC01n/A

 +99      ; SVC02n/A

 +100     ; SVC03n/A

 +101     ; SVC04n/A

 +102     ; SVC05n/A

 +103     ; SVC06n/A

 +104     ; SVC07n/A

 +105     ;

 +106     ;2210D SERVICE LINE ITEM ID

 +107     ; REF01n/a

 +108     ; REF02n/a

 +109     ;

 +110     ;2210D SERVICE LINE DATE

 +111     ; DTP01n/a

 +112     ; DTP02n/a

 +113     ; DTP03n/a

 +114     ;

DEP       ;2000E DEPENDENT LEVEL

 +1        IF $GET(BARREL)=18

               QUIT 

 +2       ; HL01

 +3        SET BAR("2762000EHL1")=5

 +4       ; HL02

 +5        SET BAR("2762000EHL2")=4

 +6       ; HL03

 +7        SET BAR("2762000EHL3")=23

 +8       ; HL04

 +9       ;S BAR("2762000EHL4")=""  not used

 +10      ;

 +11      ;2000E DEPENDENT DEMPGRAPHIC INFO

 +12      ; DMG01

 +13       SET BAR("2762000EDMG1")="D8"

 +14      ; DMG02

 +15       SET BAR("2762000EDMG2")=$$DOB^ABMUTLN($PIECE(ABMSBR,"-"),$PIECE(ABMSBR,"-",2))

 +16       IF $GET(BAR("2762000EDMG2"))

               Begin DoDot:1

 +17               SET BAR("2762000EDMG2")=$$Y2KD2^BARDUTL(BAR("2762000EDMG2"))

               End DoDot:1

 +18      ; DMG03

 +19       SET BAR("2762000EDMG3")=$$SEX^ABMUTLN($PIECE(ABMSBR,"-"),$PIECE(ABMSBR,"-",2))

 +20       IF $GET(BAR("2762000EDMG3"))=""

               SET BAR("2762000EDMG3")="U"

 +21      ;

 +22      ;2100E DEPENDENT NAME

 +23      ; NM101

 +24      ;gis

           SET BAR("2762100ENM11")="QC"

 +25      ; NM102

 +26      ;gis

           SET BAR("2762100ENM12")="1"

 +27      ; NM103

 +28       SET BARFILE=$PIECE(ABMSBR,"-")

           SET BARPIEN=$PIECE(ABMSBR,"-",2)

 +29      ;gis

           SET BAR("2762100ENM13")=$$LNM^ABMUTLN(BARFILE,BARPIEN)

 +30      ; NM104

 +31      ;gis

           SET BAR("2762100ENM14")=$$FNM^ABMUTLN(BARFILE,BARPIEN)

 +32      ; NM105

 +33       SET BAR("2762100ENM15")=$$MI^ABMUTLN(BARFILE,BARPIEN)

 +34      ; NM106n/a

 +35      ; NM107

 +36       SET BAR("2762100ENM17")=$$SFX^ABMUTLN(BARFILE,BARPIEN)

 +37      ; NM108

 +38       SET BAR("2762100ENM18")="MI"

 +39      ; NM109

 +40       SET BAR("2762100ENM19")=$GET(ABMP("PNUM"))

 +41      ;

 +42      ;

 +43      ;2200E CLAIM SUBMITTER TRACE NUMBER

 +44      ; TRN01

 +45       SET BAR("2762200ETRN1")=1

 +46      ; TRN02

 +47       SET BAR("2762200ETRN2")=$GET(BARSIEN)

 +48      ;

 +49      ;2200E PAYER CLAIM ID NUMBER

 +50      ; REF01

 +51       SET BAR("2762200EREFA1")="1K"

 +52      ; REF02

 +53       SET BAR("2762200EREFA2")=$PIECE($GET(^BARBL(BARDUZ2,BARBIEN,0)),U)

 +54      ;

 +55      ;2200E INSTITUTIONAL BILL TYPE ID

 +56      ; REF01

 +57       SET BAR("2762200EREFB1")="BLT"

 +58      ; REF02

 +59       SET BAR("2762200EREFB2")=$GET(ABMP("BTYP"))

 +60      ;

 +61      ;2200E MEDICAL RECORD ID

 +62      ; REF01

 +63       SET BAR("2762200EREFC1")="EA"

 +64      ; REF02

 +65       SET BAR("VISIT LOC")=$PIECE($GET(^BARBL(BARDUZ2,BARBIEN,1)),U,8)

 +66       IF $GET(BAR("VISIT LOC"))

               SET BAR("DEP CHART")=$PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,BAR("VISIT LOC"),0)),U,2)

 +67       SET BAR("2762200EREFC2")=$GET(BAR("DEP CHART"))

 +68      ;

 +69      ;2200E CLAIM SUBMITTED CHARGES

 +70      ; AMT01

 +71       SET BAR("2762200EAMT1")="T3"

 +72      ; AMT02

 +73       SET BAR("2762200EAMT2")=$PIECE($GET(^BARBL(BARDUZ2,BARBIEN,0)),U,13)

 +74      ; AMT03n/a

 +75      ;

 +76      ;

 +77      ;2200E CLAIM SERVICE DATE

 +78      ; DTP01

 +79       SET BAR("2762200EDTP1")=232

 +80      ; DTP02

 +81       SET BAR("2762200EDTP2")="RD8"

 +82      ; DTP03

 +83       SET BAR("DOS BEG")=$$Y2KD2^BARDUTL($PIECE($GET(^BARBL(BARDUZ2,BARBIEN,1)),U,2))

 +84       SET BAR("DOS END")=$$Y2KD2^BARDUTL($PIECE($GET(^BARBL(BARDUZ2,BARBIEN,1)),U,3))

 +85       SET BAR("2762200EDTP3")=BAR("DOS BEG")_"-"_BAR("DOS END")

 +86      ;

 +87      ;2210D SERVICE LINE INFORMATION

 +88      ; SVC01n/A

 +89      ; SVC02n/A

 +90      ; SVC03n/A

 +91      ; SVC04n/A

 +92      ; SVC05n/A

 +93      ; SVC06n/A

 +94      ; SVC07n/A

 +95      ;

 +96      ;2210D SERVICE LINE ITEM ID

 +97      ; REF01n/a

 +98      ; REF02n/a

 +99      ;

 +100     ;2210D SERVICE LINE DATE

 +101     ; DTP01n/a

 +102     ; DTP02n/a

 +103     ; DTP03n/a

 +104     ;

GIS       ;-- make the gis call

 +1        SET BARMSG=$$276^BHLEVENT(BARSIEN,.BAR)

 +2        QUIT 

 +3       ;

TS()      ;-- make a time stamp

 +1        DO NOW^%DTC

 +2        QUIT $$TS^INHUT1(%)

 +3       ;