ACHS278 ;IHS/SET/GTH - X12 278 SETUP ; [ 12/06/2002 10:36 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5**;JUN 11, 2001
;
; IHS/SET/GTH ACHS*3.1*5 12/06/2002 - New routine.
;
; E.g. (msm) :
; KILL A S A="" D GEN278^ACHS278(D,T,.A) ZW A
; where: D = IEN of the Document
; T = IEN of the Transaction:
; ^ACHSF(DUZ(2),"D",D,0)
; ^ACHSF(DUZ(2),"D",D,"T",0)
;
GEN278(ACHSDIEN,ACHSTIEN,ACHS) ;PEP - Generate an array for the 278Outbound.
; DUZ(2) must exist.
; ACHSDIEN = IEN of the Document.
; ACHSTIEN = IEN of the Transaction.
; ACHSTOS = Type Of Service:
; 43 = Inpatient
; 57 = Dental
; 64 = Outpatient
;
S ACHSTOS=$E($$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2),3),1,2)
S DFN=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",13.64,"I")
;
;TRANSACTION SET HEADER
; ST01
S ACHS("278HFST1")=278
; ST02
S ACHS("278HFST2")="0001"
;
;BEGINNING OF HIERARCHICAL TRANSACTION
; BHT01
S ACHS("278HFBHT1")="0078"
; BHT02
S ACHS("278HFBHT2")="13"
; BHT03
S ACHS("278HFBHT3")=$TR($$TS_ACHSDIEN,"-")
; BHT04
S ACHS("278HFBHT4")=$E($$TS,1,8)
; BHT05
S ACHS("278HFBHT5")=$E($$TS,9,12)
;
;2000A UMO LEVEL
; HL01
S ACHS("2782000AHL1")=1
; HL02
; HL03
S ACHS("2782000AHL3")=20
; HL04
S ACHS("2782000AHL4")=1
;
;2010A UMO NAME
; NM101
S ACHS("2782010ANM11")="X3"
; NM102
S ACHS("2782010ANM12")=2
; NM103
; NM104
; NM105
; NM106
; NM107
; NM108
S ACHS("2782010ANM18")=24
; NM109
S ACHS("2782010ANM19")=$$VNDR(ACHSDIEN)
;
;2000B REQUESTER LEVEL
; HL01
S ACHS("2782000BHL1")=2
; HL02
S ACHS("2782000BHL2")=1
; HL03
S ACHS("2782000BHL3")=21
; HL04
S ACHS("2782000BHL4")=1
;
;2010B REQUESTER NAME
; NM101
S ACHS("2782010BNM11")="FA"
; NM102
S ACHS("2782010BNM12")="2"
; NM103
S ACHS("2782010BNM13")=$$LOC^XBFUNC
; NM104
; NM105
; NM106
; NM107
; NM108
S ACHS("2782010BNM18")="24"
; NM109
S ACHS("2782010BNM19")=$$GET1^DIQ(9999999.06,DUZ(2),.21)
;2010B REQUESTER SUPPLEMENTAL ID
; REF01
S ACHS("2782010BREF1")="1J"
; REF02
S ACHS("2782010BREF2")=$$GET1^DIQ(9999999.06,DUZ(2),.0799)
;2010B REQUESTER ADDRESS
; N301
S ACHS("2782010BN31")=$$GET1^DIQ(9002080,DUZ(2)_",0",1)
; N302 n/a
;2010B REQUESTER CITY/STATE/ZIP
; N401
S ACHS("2782010BN41")=$$GET1^DIQ(9002080,DUZ(2)_",0",2)
; N402
S %=$$GET1^DIQ(9002080,DUZ(2)_",0",3,"I")
I % S ACHS("2782010BN42")=$$GET1^DIQ(5,%,1)
; N403
S ACHS("2782010BN43")=$$GET1^DIQ(9002080,DUZ(2)_",0",4)
; N404 n/a
;2010B REQUESTER CONTACT INFO
; PER01
S ACHS("2782010BPER1")="IC"
; PER02
S ACHS("2782010BPER2")=""
S %=$S(ACHSTOS=43:50,ACHSTOS=57:51,ACHSTOS=64:52,1:0)
I % S ACHS("2782010BPER2")=$$GET1^DIQ(9002080,DUZ(2)_",P",%)
; PER03
S ACHS("2782010BPER3")="TE"
; PER04
S ACHS("2782010BPER4")=$$GET1^DIQ(9999999.06,DUZ(2),.13)
; PER05n/a
; PER06n/a
; PER07n/a
; PER08n/a
;2010B REQUESTER PROVIDER INFO
; PRV01
S ACHS("2782010BPRV1")="OR"
; PRV02
S ACHS("2782010BPRV2")="ZZ" ;maw take this out
; PRV03
S ACHS("2782010BPRV3")="282N00000X" ;maw take this out placeholder
S %=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",83.13)
I % D
. S ACHS("2782010BPRV2")="ZZ"
. S ACHS("2782010BPRV3")=$$GET1^DIQ(8932.1,%,6)
;2000C SUBSCRIBER LEVEL
; HL01
S ACHS("2782000CHL1")=3
; HL02
S ACHS("2782000CHL2")=2
; HL03
S ACHS("2782000CHL3")=22
; HL04
S ACHS("2782000CHL4")=1
;
;2000C ACCIDENT DATE
; DTP01n/a
; DTP02n/a
; DTP03n/a
;2000C LAST MENSTRUAL PERIOD DATE
; DTP01n/a
; DTP02n/a
; DTP03n/a
;2000C ESTIMATED DOB
; DTP01n/a
; DTP02n/a
; DTP03n/a
;2000C ONSET OF CURRENT SYMPTOMS OR ILLNESS DATE
; DTP01n/a
; DTP02n/a
; DTP03n/a
;2000C SUBSCRIBER DIAGNOSIS
; HI01n/a
; HI02n/a
; HI03n/a
; HI04n/a
; HI05n/a
; HI06n/a
; HI07n/a
; HI08n/a
; HI09n/a
; HI10n/a
; HI11n/a
; HI12n/a
;2010C SUBSCRIBER NAME
; NM101
S ACHS("2782010CNM11")="IL"
; NM102
S ACHS("2782010CNM12")="1"
; NM103
S ACHS("2782010CNM13")=$P($$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",13.64),",",1)
; NM104
S ACHS("2782010CNM14")=$P($$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",13.64),",",2)
; NM105n/a
; NM106n/a
; NM107n/a
; NM108
S ACHS("2782010CNM18")="MI"
; NM109
S ACHS("2782010CNM19")=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",13.63)
;2010C SUBSCRIBER SUPPLEMENTAL INFO
; REF01
S ACHS("2782010CREF1")="SY"
; REF02
S ACHS("2782010CREF2")=$$SSN^AUPNPAT(DFN)
;2010C SUBSCRIBER DEMOGRAPHIC INFO
; (DMG01?)REF03
S ACHS("2782010CDMG1")="D8"
; (DMG02?)REF04
S ACHS("2782010CDMG2")=17000000+$$DOB^AUPNPAT(DFN)
; (DMG03?)REF05
S ACHS("2782010CDMG3")=$$SEX^AUPNPAT(DFN)
;2000D DEPENDENT LEVEL
; HL01
S ACHS("2782000DHL1")=4
; HL02
S ACHS("2782000DHL2")=3
; HL03
S ACHS("2782000DHL3")=23
; HL04
S ACHS("2782000DHL4")=1
;
;2000D ACCIDENT DATE
; DTP01n/a
; DTP02n/a
; DTP03n/a
;2000D LAST MENSTRUAL PERIOD DATE
; DTP01n/a
; DTP02n/a
; DTP03n/a
;2000D ESTIMATED DATE OF BIRTH
; DTP01n/a
; DTP02n/a
; DTP03n/a
;2000D ONSET OF CURRENT SYMPTOMS OR ILLNESS DATE
; DTP01n/a
; DTP02n/a
; DTP03n/a
;2000D DEPENDENT DIAGNOSIS
; HI01n/a
; HI02n/a
; HI03n/a
; HI04n/a
; HI05n/a
; HI06n/a
; HI07n/a
; HI08n/a
; HI09n/a
; HI10n/a
; HI11n/a
; HI12n/a
;2010D DEPENDENT NAME
;cmi/maw need dependant name
; NM101
S ACHS("2782010DNM11")="QC"
; NM102
S ACHS("2782010DNM12")="1"
; NM103
S ACHS("2782010DNM13")=$P($$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",13.64),",",1)
; NM104
S ACHS("2782010DNM14")=$P($$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",13.64),",",2)
; NM105n/a
; NM106n/a
; NM107n/a
; NM108n/a
; NM109n/a
;2010D DEPENDENT SUPPLEMENTAL INFORMATION
; REF01n/a
; REF02n/a
;2010D DEPENDENT DEMPGRAPHIC INFO
; DMG01n/a
; DMG02n/a
; DMG03n/a
;2010D DEPENDENT RELATIONSHIP
; INS01n/a
; INS02n/a
; INS03n/a
; INS04n/a
; INS05n/a
; INS06n/a
; INS07n/a
; INS08n/a
; INS09n/a
; INS10n/a
; INS11n/a
; INS12n/a
; INS13n/a
; INS14n/a
; INS15n/a
; INS16n/a
; INS17n/a
;2000E SERVICE PROVIDER LEVEL
; HL01
S ACHS("2782000EHL1")=5
; HL02
S ACHS("2782000EHL2")=4
; HL03
S ACHS("2782000EHL3")=19
; HL04
S ACHS("2782000EHL4")=1
;
;2000E MESSAGE TEXT
; MSG01
; ---------- CHS Purchase Order Number.
; NOTE: as of 10/09/2002, CHS WG does not want to transmit PO #.
;S ACHS("2782000EMSG1")=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",.01)
; ---------- If COMMENTS exist, append it.
S %=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",12)
I $L(%) S ACHS("2782000EMSG1")=$S($G(ACHS("2782000EMSG1")):ACHS("2782000EMSG1")_" : ",1:"")_%
;2010E SERVICE PROVIDER NAME
; NM101
S ACHS("2782010ENM11")="SJ"
; NM102
S ACHS("2782010ENM12")="2"
; NM103
S ACHS("2782010ENM13")=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7)
; NM104n/a
; NM105n/a
; NM106n/a
; NM107n/a
; NM108
S ACHS("2782010ENM18")="24"
; NM109
S ACHS("2782010ENM19")=$$GET1^DIQ(9999999.11,$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7,"I"),1101)
S %=$$GET1^DIQ(9999999.11,$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7,"I"),1102)
I $L(%) S ACHS("2782010ENM19")=ACHS("2782010ENM19")_"-"_%
;2010E SERVICE PROVIDER SUPPLEMENTAL INFO
; REF01n/a
; REF02n/a
;2010E SERVICE PROVIDER ADDRESS
; N301
S ACHS("2782010EN31")=$$GET1^DIQ(9999999.11,$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7,"I"),1301)
; N302n/a
;2010E SERVICE PROVIDER CITY/STATE/ZIP
; N401
S ACHS("2782010EN41")=$$GET1^DIQ(9999999.11,$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7,"I"),1302)
; N402
S ACHS("2782010EN42")=$$GET1^DIQ(5,$$GET1^DIQ(9999999.11,$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7,"I"),1303,"I"),1)
; N403
S ACHS("2782010EN43")=$$GET1^DIQ(9999999.11,$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7,"I"),1304)
; N404n/a
;2010E SERVICE PROVIDER CONTACT INFO
; PER01
S ACHS("2782010EPER1")="IC"
; PER02
S ACHS("2782010EPER2")=$$GET1^DIQ(9999999.11,$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7,"I"),1305)
; PER03
S ACHS("2782010EPER3")="TE"
; PER04
S ACHS("2782010EPER4")=$$GET1^DIQ(9999999.11,$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7,"I"),1109)
; PER05n/a
; PER06n/a
; PER07n/a
; PER08n/a
;2010E SERVICE PROVIDER INFO
; PRV01n/a
; PRV02n/a
; PRV03n/a
;2000F SERVICE LEVEL
; HL01
S ACHS("2782000FHL1")=6
; HL02
S ACHS("2782000FHL2")=5
; HL03
S ACHS("2782000FHL3")="SS"
; HL04
S ACHS("2782000FHL4")=0
;
;2000F SERVICE TRACE NUMBER
; TRN01n/a
; TRN02n/a
; TRN03n/a
; TRN04n/a
;2000F HEALTH CARE SERVICES REVIEW INFO
; UM01
S ACHS("2782000FUM1")=$S(ACHSTOS=43:"AR",ACHSTOS=57:"SC",ACHSTOS=64:"HS",1:"")
; UM02
S %=$$GET1^DIQ(9002080.02,ACHSDIEN_","_ACHSTIEN_","_DUZ(2)_",",1,"I")
S ACHS("2782000FUM2")=$S(%="I":"I",%="S":"S",%="Z":"S",%="C":3,1:"I")
; UM03n/a
; UM04n/a
; UM05n/a
; UM06
S ACHS("2782000FUM6")=$S($$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",81,"I")="I":"03",1:"")
; UM07n/a
; UM08n/a
; UM09
S ACHS("2782000FUM9")=$S($P(^AUPNPAT(DFN,0),"^",3)&'$P(^AUPNPAT(DFN,0),"^",4):"Y",1:"M")
; UM10n/a
;2000F PREVIOUS CERTIFICATION ID
; REF01
; REF02
;2000F SERVICE DATE
; DTP01
S ACHS("2782000FDTPA1")="472"
; DTP02
S ACHS("2782000FDTPA2")="D8"
; DTP03
S ACHS("2782000FDTPA3")=17000000+$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",83.11,"I")
;2000F ADMISSION DATE
; DTP03
S ACHS("2782000FDTPB3")=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",91,"I")
I ACHS("2782000FDTPB3") S ACHS("2782000FDTPB3")=17000000+ACHS("DTP032000F","435")
; DTP01
I ACHS("2782000FDTPB3") S ACHS("2782000FDTPB1")="435"
; DTP02
I ACHS("2782000FDTPB3") S ACHS("2782000FDTPB2")="D8"
;
;2000F DISCHARGE DATE
; DTP03
S ACHS("2782000FDTPC3")=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",92,"I")
I ACHS("2782000FDTPC3") S ACHS("2782000FDTPC3")=17000000+ACHS("DTP032000F","096")
; DTP01
I ACHS("2782000FDTPC3") S ACHS("2782000FDTPC1")="096"
; DTP02
I ACHS("2782000FDTPC3") S ACHS("2782000FDTPC2")="D8"
;
;2000F PROCEDURES
; HI01n/a
; HI02n/a
; HI03n/a
; HI04n/a
; HI05n/a
; HI06n/a
; HI07n/a
; HI08n/a
; HI09n/a
; HI10n/a
; HI11n/a
; HI12n/a
;2000F HEALTH CARE SERVICES DELIVERY
; HSD01
S ACHS("2782000FHSD1")="DY"
; HSD02
S ACHS("2782000FHSD2")=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",25)
I $G(ACHS("2782000FHSD2"))="" S ACHS("2782000FHSD2")=1
; HSD03n/a
; HSD04n/a
; HSD05n/a
; HSD06n/a
; HSD07n/a
; HSD08n/a
;2000F PATIENT CONDITION INFO
; CRC01n/a
; CRC02n/a
; CRC03n/a
; CRC04n/a
; CRC05n/a
; CRC06n/a
; CRC07n/a
;2000F INSTITUTIONAL CLAIM CODE
; CL101n/a
; CL102n/a
; CL103n/a
; CL104n/a
;2000F AMBULANCE TRANSPORT INFO
; CR101n/a
; CR102n/a
; CR103n/a
; CR104n/a
; CR105n/a
; CR106n/a
; CR107n/a
; CR108n/a
; CR109n/a
; CR110n/a
; CR111n/a
; CR112n/a
;2000F SPINAL MANIPULATION SERVICE INFO
; CR201n/a
; CR202n/a
; CR203n/a
; CR204n/a
; CR205n/a
; CR206n/a
; CR207n/a
; CR208n/a
; CR209n/a
; CR210n/a
; CR211n/a
; CR212n/a
;2000F HOME OXYGEN THERAPY INFO
; CR501n/a
; CR502n/a
; CR503n/a
; CR504n/a
; CR505n/a
; CR506n/a
; CR507n/a
; CR508n/a
; CR509n/a
; CR510n/a
; CR511n/a
; CR512n/a
; CR513n/a
; CR514n/a
; CR515n/a
; CR516n/a
; CR517n/a
; CR518n/a
;2000F HOME HEALTH CARE INFO
; CR601n/a
; CR602n/a
; CR603n/a
; CR604n/a
; CR605n/a
; CR606n/a
; CR607n/a
; CR608n/a
; CR609n/a
; CR610n/a
; CR611n/a
; CR612n/a
; CR613n/a
; CR614n/a
; CR615n/a
; CR616n/a
; CR617n/a
;2000F MESSAGE TEXT
; MSG01
S ACHS("2782000FMSG1")=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",26)
; TRANSACTION SET TRAILER
; SE02
S ACHS("278HFSE2")="0001"
; SE01
S ACHS("278HFSE1")=$$SEGCNT
Q
;
TS() ;-- make a time stamp
D NOW^%DTC
Q $$TS^INHUT1(%)
;
VNDR(I) ;-- get the vendors ein
NEW V
S V=$P($G(^ACHSF(DUZ(2),"D",I,0)),U,7)
I V="" Q ""
Q $P($G(^AUTTVNDR(V,11)),U)
;
SEGCNT() ;-- count number of segments
NEW C,D
S (C,D)=0
F S D=$O(ACHS(D)) Q:D="" S C=C+1
Q $G(C)
;
ACHS278 ;IHS/SET/GTH - X12 278 SETUP ; [ 12/06/2002 10:36 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5**;JUN 11, 2001
+2 ;
+3 ; IHS/SET/GTH ACHS*3.1*5 12/06/2002 - New routine.
+4 ;
+5 ; E.g. (msm) :
+6 ; KILL A S A="" D GEN278^ACHS278(D,T,.A) ZW A
+7 ; where: D = IEN of the Document
+8 ; T = IEN of the Transaction:
+9 ; ^ACHSF(DUZ(2),"D",D,0)
+10 ; ^ACHSF(DUZ(2),"D",D,"T",0)
+11 ;
GEN278(ACHSDIEN,ACHSTIEN,ACHS) ;PEP - Generate an array for the 278Outbound.
+1 ; DUZ(2) must exist.
+2 ; ACHSDIEN = IEN of the Document.
+3 ; ACHSTIEN = IEN of the Transaction.
+4 ; ACHSTOS = Type Of Service:
+5 ; 43 = Inpatient
+6 ; 57 = Dental
+7 ; 64 = Outpatient
+8 ;
+9 SET ACHSTOS=$EXTRACT($$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2),3),1,2)
+10 SET DFN=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",13.64,"I")
+11 ;
+12 ;TRANSACTION SET HEADER
+13 ; ST01
+14 SET ACHS("278HFST1")=278
+15 ; ST02
+16 SET ACHS("278HFST2")="0001"
+17 ;
+18 ;BEGINNING OF HIERARCHICAL TRANSACTION
+19 ; BHT01
+20 SET ACHS("278HFBHT1")="0078"
+21 ; BHT02
+22 SET ACHS("278HFBHT2")="13"
+23 ; BHT03
+24 SET ACHS("278HFBHT3")=$TRANSLATE($$TS_ACHSDIEN,"-")
+25 ; BHT04
+26 SET ACHS("278HFBHT4")=$EXTRACT($$TS,1,8)
+27 ; BHT05
+28 SET ACHS("278HFBHT5")=$EXTRACT($$TS,9,12)
+29 ;
+30 ;2000A UMO LEVEL
+31 ; HL01
+32 SET ACHS("2782000AHL1")=1
+33 ; HL02
+34 ; HL03
+35 SET ACHS("2782000AHL3")=20
+36 ; HL04
+37 SET ACHS("2782000AHL4")=1
+38 ;
+39 ;2010A UMO NAME
+40 ; NM101
+41 SET ACHS("2782010ANM11")="X3"
+42 ; NM102
+43 SET ACHS("2782010ANM12")=2
+44 ; NM103
+45 ; NM104
+46 ; NM105
+47 ; NM106
+48 ; NM107
+49 ; NM108
+50 SET ACHS("2782010ANM18")=24
+51 ; NM109
+52 SET ACHS("2782010ANM19")=$$VNDR(ACHSDIEN)
+53 ;
+54 ;2000B REQUESTER LEVEL
+55 ; HL01
+56 SET ACHS("2782000BHL1")=2
+57 ; HL02
+58 SET ACHS("2782000BHL2")=1
+59 ; HL03
+60 SET ACHS("2782000BHL3")=21
+61 ; HL04
+62 SET ACHS("2782000BHL4")=1
+63 ;
+64 ;2010B REQUESTER NAME
+65 ; NM101
+66 SET ACHS("2782010BNM11")="FA"
+67 ; NM102
+68 SET ACHS("2782010BNM12")="2"
+69 ; NM103
+70 SET ACHS("2782010BNM13")=$$LOC^XBFUNC
+71 ; NM104
+72 ; NM105
+73 ; NM106
+74 ; NM107
+75 ; NM108
+76 SET ACHS("2782010BNM18")="24"
+77 ; NM109
+78 SET ACHS("2782010BNM19")=$$GET1^DIQ(9999999.06,DUZ(2),.21)
+79 ;2010B REQUESTER SUPPLEMENTAL ID
+80 ; REF01
+81 SET ACHS("2782010BREF1")="1J"
+82 ; REF02
+83 SET ACHS("2782010BREF2")=$$GET1^DIQ(9999999.06,DUZ(2),.0799)
+84 ;2010B REQUESTER ADDRESS
+85 ; N301
+86 SET ACHS("2782010BN31")=$$GET1^DIQ(9002080,DUZ(2)_",0",1)
+87 ; N302 n/a
+88 ;2010B REQUESTER CITY/STATE/ZIP
+89 ; N401
+90 SET ACHS("2782010BN41")=$$GET1^DIQ(9002080,DUZ(2)_",0",2)
+91 ; N402
+92 SET %=$$GET1^DIQ(9002080,DUZ(2)_",0",3,"I")
+93 IF %
SET ACHS("2782010BN42")=$$GET1^DIQ(5,%,1)
+94 ; N403
+95 SET ACHS("2782010BN43")=$$GET1^DIQ(9002080,DUZ(2)_",0",4)
+96 ; N404 n/a
+97 ;2010B REQUESTER CONTACT INFO
+98 ; PER01
+99 SET ACHS("2782010BPER1")="IC"
+100 ; PER02
+101 SET ACHS("2782010BPER2")=""
+102 SET %=$SELECT(ACHSTOS=43:50,ACHSTOS=57:51,ACHSTOS=64:52,1:0)
+103 IF %
SET ACHS("2782010BPER2")=$$GET1^DIQ(9002080,DUZ(2)_",P",%)
+104 ; PER03
+105 SET ACHS("2782010BPER3")="TE"
+106 ; PER04
+107 SET ACHS("2782010BPER4")=$$GET1^DIQ(9999999.06,DUZ(2),.13)
+108 ; PER05n/a
+109 ; PER06n/a
+110 ; PER07n/a
+111 ; PER08n/a
+112 ;2010B REQUESTER PROVIDER INFO
+113 ; PRV01
+114 SET ACHS("2782010BPRV1")="OR"
+115 ; PRV02
+116 ;maw take this out
SET ACHS("2782010BPRV2")="ZZ"
+117 ; PRV03
+118 ;maw take this out placeholder
SET ACHS("2782010BPRV3")="282N00000X"
+119 SET %=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",83.13)
+120 IF %
Begin DoDot:1
+121 SET ACHS("2782010BPRV2")="ZZ"
+122 SET ACHS("2782010BPRV3")=$$GET1^DIQ(8932.1,%,6)
End DoDot:1
+123 ;2000C SUBSCRIBER LEVEL
+124 ; HL01
+125 SET ACHS("2782000CHL1")=3
+126 ; HL02
+127 SET ACHS("2782000CHL2")=2
+128 ; HL03
+129 SET ACHS("2782000CHL3")=22
+130 ; HL04
+131 SET ACHS("2782000CHL4")=1
+132 ;
+133 ;2000C ACCIDENT DATE
+134 ; DTP01n/a
+135 ; DTP02n/a
+136 ; DTP03n/a
+137 ;2000C LAST MENSTRUAL PERIOD DATE
+138 ; DTP01n/a
+139 ; DTP02n/a
+140 ; DTP03n/a
+141 ;2000C ESTIMATED DOB
+142 ; DTP01n/a
+143 ; DTP02n/a
+144 ; DTP03n/a
+145 ;2000C ONSET OF CURRENT SYMPTOMS OR ILLNESS DATE
+146 ; DTP01n/a
+147 ; DTP02n/a
+148 ; DTP03n/a
+149 ;2000C SUBSCRIBER DIAGNOSIS
+150 ; HI01n/a
+151 ; HI02n/a
+152 ; HI03n/a
+153 ; HI04n/a
+154 ; HI05n/a
+155 ; HI06n/a
+156 ; HI07n/a
+157 ; HI08n/a
+158 ; HI09n/a
+159 ; HI10n/a
+160 ; HI11n/a
+161 ; HI12n/a
+162 ;2010C SUBSCRIBER NAME
+163 ; NM101
+164 SET ACHS("2782010CNM11")="IL"
+165 ; NM102
+166 SET ACHS("2782010CNM12")="1"
+167 ; NM103
+168 SET ACHS("2782010CNM13")=$PIECE($$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",13.64),",",1)
+169 ; NM104
+170 SET ACHS("2782010CNM14")=$PIECE($$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",13.64),",",2)
+171 ; NM105n/a
+172 ; NM106n/a
+173 ; NM107n/a
+174 ; NM108
+175 SET ACHS("2782010CNM18")="MI"
+176 ; NM109
+177 SET ACHS("2782010CNM19")=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",13.63)
+178 ;2010C SUBSCRIBER SUPPLEMENTAL INFO
+179 ; REF01
+180 SET ACHS("2782010CREF1")="SY"
+181 ; REF02
+182 SET ACHS("2782010CREF2")=$$SSN^AUPNPAT(DFN)
+183 ;2010C SUBSCRIBER DEMOGRAPHIC INFO
+184 ; (DMG01?)REF03
+185 SET ACHS("2782010CDMG1")="D8"
+186 ; (DMG02?)REF04
+187 SET ACHS("2782010CDMG2")=17000000+$$DOB^AUPNPAT(DFN)
+188 ; (DMG03?)REF05
+189 SET ACHS("2782010CDMG3")=$$SEX^AUPNPAT(DFN)
+190 ;2000D DEPENDENT LEVEL
+191 ; HL01
+192 SET ACHS("2782000DHL1")=4
+193 ; HL02
+194 SET ACHS("2782000DHL2")=3
+195 ; HL03
+196 SET ACHS("2782000DHL3")=23
+197 ; HL04
+198 SET ACHS("2782000DHL4")=1
+199 ;
+200 ;2000D ACCIDENT DATE
+201 ; DTP01n/a
+202 ; DTP02n/a
+203 ; DTP03n/a
+204 ;2000D LAST MENSTRUAL PERIOD DATE
+205 ; DTP01n/a
+206 ; DTP02n/a
+207 ; DTP03n/a
+208 ;2000D ESTIMATED DATE OF BIRTH
+209 ; DTP01n/a
+210 ; DTP02n/a
+211 ; DTP03n/a
+212 ;2000D ONSET OF CURRENT SYMPTOMS OR ILLNESS DATE
+213 ; DTP01n/a
+214 ; DTP02n/a
+215 ; DTP03n/a
+216 ;2000D DEPENDENT DIAGNOSIS
+217 ; HI01n/a
+218 ; HI02n/a
+219 ; HI03n/a
+220 ; HI04n/a
+221 ; HI05n/a
+222 ; HI06n/a
+223 ; HI07n/a
+224 ; HI08n/a
+225 ; HI09n/a
+226 ; HI10n/a
+227 ; HI11n/a
+228 ; HI12n/a
+229 ;2010D DEPENDENT NAME
+230 ;cmi/maw need dependant name
+231 ; NM101
+232 SET ACHS("2782010DNM11")="QC"
+233 ; NM102
+234 SET ACHS("2782010DNM12")="1"
+235 ; NM103
+236 SET ACHS("2782010DNM13")=$PIECE($$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",13.64),",",1)
+237 ; NM104
+238 SET ACHS("2782010DNM14")=$PIECE($$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",13.64),",",2)
+239 ; NM105n/a
+240 ; NM106n/a
+241 ; NM107n/a
+242 ; NM108n/a
+243 ; NM109n/a
+244 ;2010D DEPENDENT SUPPLEMENTAL INFORMATION
+245 ; REF01n/a
+246 ; REF02n/a
+247 ;2010D DEPENDENT DEMPGRAPHIC INFO
+248 ; DMG01n/a
+249 ; DMG02n/a
+250 ; DMG03n/a
+251 ;2010D DEPENDENT RELATIONSHIP
+252 ; INS01n/a
+253 ; INS02n/a
+254 ; INS03n/a
+255 ; INS04n/a
+256 ; INS05n/a
+257 ; INS06n/a
+258 ; INS07n/a
+259 ; INS08n/a
+260 ; INS09n/a
+261 ; INS10n/a
+262 ; INS11n/a
+263 ; INS12n/a
+264 ; INS13n/a
+265 ; INS14n/a
+266 ; INS15n/a
+267 ; INS16n/a
+268 ; INS17n/a
+269 ;2000E SERVICE PROVIDER LEVEL
+270 ; HL01
+271 SET ACHS("2782000EHL1")=5
+272 ; HL02
+273 SET ACHS("2782000EHL2")=4
+274 ; HL03
+275 SET ACHS("2782000EHL3")=19
+276 ; HL04
+277 SET ACHS("2782000EHL4")=1
+278 ;
+279 ;2000E MESSAGE TEXT
+280 ; MSG01
+281 ; ---------- CHS Purchase Order Number.
+282 ; NOTE: as of 10/09/2002, CHS WG does not want to transmit PO #.
+283 ;S ACHS("2782000EMSG1")=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",.01)
+284 ; ---------- If COMMENTS exist, append it.
+285 SET %=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",12)
+286 IF $LENGTH(%)
SET ACHS("2782000EMSG1")=$SELECT($GET(ACHS("2782000EMSG1")):ACHS("2782000EMSG1")_" : ",1:"")_%
+287 ;2010E SERVICE PROVIDER NAME
+288 ; NM101
+289 SET ACHS("2782010ENM11")="SJ"
+290 ; NM102
+291 SET ACHS("2782010ENM12")="2"
+292 ; NM103
+293 SET ACHS("2782010ENM13")=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7)
+294 ; NM104n/a
+295 ; NM105n/a
+296 ; NM106n/a
+297 ; NM107n/a
+298 ; NM108
+299 SET ACHS("2782010ENM18")="24"
+300 ; NM109
+301 SET ACHS("2782010ENM19")=$$GET1^DIQ(9999999.11,$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7,"I"),1101)
+302 SET %=$$GET1^DIQ(9999999.11,$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7,"I"),1102)
+303 IF $LENGTH(%)
SET ACHS("2782010ENM19")=ACHS("2782010ENM19")_"-"_%
+304 ;2010E SERVICE PROVIDER SUPPLEMENTAL INFO
+305 ; REF01n/a
+306 ; REF02n/a
+307 ;2010E SERVICE PROVIDER ADDRESS
+308 ; N301
+309 SET ACHS("2782010EN31")=$$GET1^DIQ(9999999.11,$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7,"I"),1301)
+310 ; N302n/a
+311 ;2010E SERVICE PROVIDER CITY/STATE/ZIP
+312 ; N401
+313 SET ACHS("2782010EN41")=$$GET1^DIQ(9999999.11,$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7,"I"),1302)
+314 ; N402
+315 SET ACHS("2782010EN42")=$$GET1^DIQ(5,$$GET1^DIQ(9999999.11,$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7,"I"),1303,"I"),1)
+316 ; N403
+317 SET ACHS("2782010EN43")=$$GET1^DIQ(9999999.11,$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7,"I"),1304)
+318 ; N404n/a
+319 ;2010E SERVICE PROVIDER CONTACT INFO
+320 ; PER01
+321 SET ACHS("2782010EPER1")="IC"
+322 ; PER02
+323 SET ACHS("2782010EPER2")=$$GET1^DIQ(9999999.11,$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7,"I"),1305)
+324 ; PER03
+325 SET ACHS("2782010EPER3")="TE"
+326 ; PER04
+327 SET ACHS("2782010EPER4")=$$GET1^DIQ(9999999.11,$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",7,"I"),1109)
+328 ; PER05n/a
+329 ; PER06n/a
+330 ; PER07n/a
+331 ; PER08n/a
+332 ;2010E SERVICE PROVIDER INFO
+333 ; PRV01n/a
+334 ; PRV02n/a
+335 ; PRV03n/a
+336 ;2000F SERVICE LEVEL
+337 ; HL01
+338 SET ACHS("2782000FHL1")=6
+339 ; HL02
+340 SET ACHS("2782000FHL2")=5
+341 ; HL03
+342 SET ACHS("2782000FHL3")="SS"
+343 ; HL04
+344 SET ACHS("2782000FHL4")=0
+345 ;
+346 ;2000F SERVICE TRACE NUMBER
+347 ; TRN01n/a
+348 ; TRN02n/a
+349 ; TRN03n/a
+350 ; TRN04n/a
+351 ;2000F HEALTH CARE SERVICES REVIEW INFO
+352 ; UM01
+353 SET ACHS("2782000FUM1")=$SELECT(ACHSTOS=43:"AR",ACHSTOS=57:"SC",ACHSTOS=64:"HS",1:"")
+354 ; UM02
+355 SET %=$$GET1^DIQ(9002080.02,ACHSDIEN_","_ACHSTIEN_","_DUZ(2)_",",1,"I")
+356 SET ACHS("2782000FUM2")=$SELECT(%="I":"I",%="S":"S",%="Z":"S",%="C":3,1:"I")
+357 ; UM03n/a
+358 ; UM04n/a
+359 ; UM05n/a
+360 ; UM06
+361 SET ACHS("2782000FUM6")=$SELECT($$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",81,"I")="I":"03",1:"")
+362 ; UM07n/a
+363 ; UM08n/a
+364 ; UM09
+365 SET ACHS("2782000FUM9")=$SELECT($PIECE(^AUPNPAT(DFN,0),"^",3)&'$PIECE(^AUPNPAT(DFN,0),"^",4):"Y",1:"M")
+366 ; UM10n/a
+367 ;2000F PREVIOUS CERTIFICATION ID
+368 ; REF01
+369 ; REF02
+370 ;2000F SERVICE DATE
+371 ; DTP01
+372 SET ACHS("2782000FDTPA1")="472"
+373 ; DTP02
+374 SET ACHS("2782000FDTPA2")="D8"
+375 ; DTP03
+376 SET ACHS("2782000FDTPA3")=17000000+$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",83.11,"I")
+377 ;2000F ADMISSION DATE
+378 ; DTP03
+379 SET ACHS("2782000FDTPB3")=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",91,"I")
+380 IF ACHS("2782000FDTPB3")
SET ACHS("2782000FDTPB3")=17000000+ACHS("DTP032000F","435")
+381 ; DTP01
+382 IF ACHS("2782000FDTPB3")
SET ACHS("2782000FDTPB1")="435"
+383 ; DTP02
+384 IF ACHS("2782000FDTPB3")
SET ACHS("2782000FDTPB2")="D8"
+385 ;
+386 ;2000F DISCHARGE DATE
+387 ; DTP03
+388 SET ACHS("2782000FDTPC3")=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",92,"I")
+389 IF ACHS("2782000FDTPC3")
SET ACHS("2782000FDTPC3")=17000000+ACHS("DTP032000F","096")
+390 ; DTP01
+391 IF ACHS("2782000FDTPC3")
SET ACHS("2782000FDTPC1")="096"
+392 ; DTP02
+393 IF ACHS("2782000FDTPC3")
SET ACHS("2782000FDTPC2")="D8"
+394 ;
+395 ;2000F PROCEDURES
+396 ; HI01n/a
+397 ; HI02n/a
+398 ; HI03n/a
+399 ; HI04n/a
+400 ; HI05n/a
+401 ; HI06n/a
+402 ; HI07n/a
+403 ; HI08n/a
+404 ; HI09n/a
+405 ; HI10n/a
+406 ; HI11n/a
+407 ; HI12n/a
+408 ;2000F HEALTH CARE SERVICES DELIVERY
+409 ; HSD01
+410 SET ACHS("2782000FHSD1")="DY"
+411 ; HSD02
+412 SET ACHS("2782000FHSD2")=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",25)
+413 IF $GET(ACHS("2782000FHSD2"))=""
SET ACHS("2782000FHSD2")=1
+414 ; HSD03n/a
+415 ; HSD04n/a
+416 ; HSD05n/a
+417 ; HSD06n/a
+418 ; HSD07n/a
+419 ; HSD08n/a
+420 ;2000F PATIENT CONDITION INFO
+421 ; CRC01n/a
+422 ; CRC02n/a
+423 ; CRC03n/a
+424 ; CRC04n/a
+425 ; CRC05n/a
+426 ; CRC06n/a
+427 ; CRC07n/a
+428 ;2000F INSTITUTIONAL CLAIM CODE
+429 ; CL101n/a
+430 ; CL102n/a
+431 ; CL103n/a
+432 ; CL104n/a
+433 ;2000F AMBULANCE TRANSPORT INFO
+434 ; CR101n/a
+435 ; CR102n/a
+436 ; CR103n/a
+437 ; CR104n/a
+438 ; CR105n/a
+439 ; CR106n/a
+440 ; CR107n/a
+441 ; CR108n/a
+442 ; CR109n/a
+443 ; CR110n/a
+444 ; CR111n/a
+445 ; CR112n/a
+446 ;2000F SPINAL MANIPULATION SERVICE INFO
+447 ; CR201n/a
+448 ; CR202n/a
+449 ; CR203n/a
+450 ; CR204n/a
+451 ; CR205n/a
+452 ; CR206n/a
+453 ; CR207n/a
+454 ; CR208n/a
+455 ; CR209n/a
+456 ; CR210n/a
+457 ; CR211n/a
+458 ; CR212n/a
+459 ;2000F HOME OXYGEN THERAPY INFO
+460 ; CR501n/a
+461 ; CR502n/a
+462 ; CR503n/a
+463 ; CR504n/a
+464 ; CR505n/a
+465 ; CR506n/a
+466 ; CR507n/a
+467 ; CR508n/a
+468 ; CR509n/a
+469 ; CR510n/a
+470 ; CR511n/a
+471 ; CR512n/a
+472 ; CR513n/a
+473 ; CR514n/a
+474 ; CR515n/a
+475 ; CR516n/a
+476 ; CR517n/a
+477 ; CR518n/a
+478 ;2000F HOME HEALTH CARE INFO
+479 ; CR601n/a
+480 ; CR602n/a
+481 ; CR603n/a
+482 ; CR604n/a
+483 ; CR605n/a
+484 ; CR606n/a
+485 ; CR607n/a
+486 ; CR608n/a
+487 ; CR609n/a
+488 ; CR610n/a
+489 ; CR611n/a
+490 ; CR612n/a
+491 ; CR613n/a
+492 ; CR614n/a
+493 ; CR615n/a
+494 ; CR616n/a
+495 ; CR617n/a
+496 ;2000F MESSAGE TEXT
+497 ; MSG01
+498 SET ACHS("2782000FMSG1")=$$GET1^DIQ(9002080.01,ACHSDIEN_","_DUZ(2)_",",26)
+499 ; TRANSACTION SET TRAILER
+500 ; SE02
+501 SET ACHS("278HFSE2")="0001"
+502 ; SE01
+503 SET ACHS("278HFSE1")=$$SEGCNT
+504 QUIT
+505 ;
TS() ;-- make a time stamp
+1 DO NOW^%DTC
+2 QUIT $$TS^INHUT1(%)
+3 ;
VNDR(I) ;-- get the vendors ein
+1 NEW V
+2 SET V=$PIECE($GET(^ACHSF(DUZ(2),"D",I,0)),U,7)
+3 IF V=""
QUIT ""
+4 QUIT $PIECE($GET(^AUTTVNDR(V,11)),U)
+5 ;
SEGCNT() ;-- count number of segments
+1 NEW C,D
+2 SET (C,D)=0
+3 FOR
SET D=$ORDER(ACHS(D))
IF D=""
QUIT
SET C=C+1
+4 QUIT $GET(C)
+5 ;
