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 ;
