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

APCLSIHL.m

Go to the documentation of this file. 
  1. APCLSIHL ;cmi/flag/maw - APCL ILI CDC HL7 Export 5/12/2010 9:26:17 AM
  1.  ;;3.0;IHS PCC REPORTS;**29,30,31**;FEB 05, 1997;Build 32
  1.  ;
  1. ILI(TYPE) ;EP -  lets create the ILI HL7 export here
  1.  N APCLLAST
  1.  D BATCH(.HLPARM,TYPE)
  1.  S APCLLAST=$$GETLAST()
  1.  D APCLDATA(.HLMSTATE,.HLPARM,TYPE)
  1.  I $G(HLMSTATE("IEN")) D GL(HLMSTATE("IEN"),TYPE)
  1.  K HLMSTATE,HLPARM
  1.  Q
  1.  ;
  1. BATCH(HLPARM,TYP) ;-- start the message batch here
  1.  S HLPARM("COUNTRY")="USA"
  1.  S HLPARM("VERSION")="2.5.1"
  1.  I '$$NEWBATCH^HLOAPI(.HLPARM,.HLMSTATE,.ERROR) D  Q
  1.  . S ERR=$G(ERR)
  1.  Q
  1.  ;
  1. GETLAST() ;-- get the last record
  1.  N BDA,LAST
  1.  S BDA=0 F  S BDA=$O(^APCLDATA($J,BDA)) Q:'BDA!($G(LAST))  D
  1.  . I $P(^APCLDATA($J,BDA),",",1)="" S LAST=(BDA-1)
  1.  Q $G(LAST)
  1.  ;
  1. ZHS(TYP) ;-- lets create the ZHS segment
  1.  N ZHS,ZHS1,ZHS2,ZHS3,ZHS4,ZHS5,ZHS6
  1.  I TYP="ILI" D
  1.  . N DBIDI,DBID,ILII,PT,LOC,ASUFAC,LAST,LASTDT,TOT
  1.  . S DBIDI=$P($G(^AUTTSITE(1,0)),U)
  1.  . S DBID=$P($G(^AUTTLOC(DBIDI,1)),U,3)
  1.  . S ILII=$O(^APCLILIC("B",0))
  1.  . S PT="P"
  1.  . I $P($G(^APCLILIC(ILII,0)),U,5)="T" S PT="T"
  1.  . S LOC=$P($G(^DIC(4,DBIDI,0)),U)
  1.  . S LASTDT=$O(^APCLILIC(ILII,12,"B",""),-1)
  1.  . S LAST=$S($G(LASTDT):$O(^APCLILIC(ILII,12,"B",LASTDT,""),-1),1:"")
  1.  . S ASUFAC=$P($G(^AUTTLOC(DBIDI,0)),U,10)_$$FMTHL7^XLFDT(APCLZHSD)
  1.  . S TOT=$S($G(LAST):$P($G(^APCLILIC(ILII,12,LAST,0)),U,4),1:0)
  1.  . D SET(.ARY,"ZHS",0)
  1.  . D SET(.ARY,DBID,1)
  1.  . D SET(.ARY,PT,2)
  1.  . D SET(.ARY,APCLVTOT,3)
  1.  . D SET(.ARY,$$FMTHL7^XLFDT(APCLZHSD),4)
  1.  . D SET(.ARY,LOC,5)
  1.  . D SET(.ARY,ASUFAC,6)
  1.  . S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.   Q
  1.  ;
  1. ZTS(TYP,LA) ;-- lets create the ZTS segment
  1.  N ZTS,ZTS1,ZTS2,ZTS3,ZTS4,ZTS5
  1.  I TYP="ILI" D
  1.  . N CNT,RDA,RDATA,RLOC,RDT,RCNT1,RCNT2,RCNT3
  1.  . S CNT=0
  1.  . S RDA=LA F  S RDA=$O(^APCLDATA($J,RDA)) Q:'RDA  D
  1.  .. Q:$P(^APCLDATA($J,RDA),",",1)]""
  1.  .. S CNT=CNT+1
  1.  .. S RDATA=$G(^APCLDATA($J,RDA))
  1.  .. S RLOC=$P(RDATA,",",6)
  1.  .. S RDT=$$FMTHL7^XLFDT($P(RDATA,",",7))
  1.  .. S RCNT1=$P(RDATA,",",13)
  1.  .. S RCNT2=$P(RDATA,",",20)
  1.  .. S RCNT3=$P(RDATA,",",42)
  1.  .. D SET(.ARY,"ZTS",0)
  1.  .. D SET(.ARY,CNT,1)
  1.  .. D SET(.ARY,RDT,2)
  1.  .. D SET(.ARY,RLOC,3)
  1.  .. D SET(.ARY,RCNT1,4)
  1.  .. D SET(.ARY,RCNT2,5)
  1.  .. D SET(.ARY,RCNT3,6)
  1.  .. S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  Q
  1.  ;
  1. APCLDATA(HLMSTATE,HLPARM,TYP) ;-- loop through ^APCLDATA here and create each message
  1.  N APCLDA,APCLCNT,APCLREC
  1.  S APCLCNT=0
  1.  S APCLDA=0 F  S APCLDA=$O(^APCLDATA($J,APCLDA)) Q:'APCLDA  Q:$P(^APCLDATA($J,APCLDA),",",1)=""  D
  1.  . S APCLCNT=APCLCNT+1
  1.  . S APCLREC=$G(^APCLDATA($J,APCLDA))
  1.  . S DFN=$P(APCLREC,",",1)
  1.  . S DFN=+$E(DFN,6,15)
  1.  . N I
  1.  . I TYP="ILI" F I=1:1:300 S APCLREC(I)=$P(APCLREC,",",I)
  1.  . D NEWMSG(.HLMSTATE,.HLPARM,.APCLREC,"ADT","A08",TYP,APCLDA)
  1.  Q
  1.  ;
  1. NEWMSG(HLST,HLPM,RC,MTYPE,EVNTTYPE,TYP,LDA) ;EP
  1.  N ARY,HLQ,APPARMS,HLMSGIEN,HLECH,HLFS,ERR,WHO
  1.  N LN,HL1,HRCN,FLD,LP,X,LN
  1.  S LN=0
  1.  S HLPM("MESSAGE TYPE")=MTYPE
  1.  S HLPM("EVENT")=EVNTTYPE
  1.  I '$$ADDMSG^HLOAPI(.HLST,.HLPM,.ERR) D  Q
  1.  .S ERR=$G(ERR)
  1.  S HLFS=HLPM("FIELD SEPARATOR")
  1.  S HLECH=HLPM("ENCODING CHARACTERS")
  1.  S HL1("ECH")=HLECH
  1.  S HL1("FS")=HLFS
  1.  S HL1("Q")=""
  1.  S HL1("VER")=HLPM("VERSION")
  1.  ;Create segments
  1.  ;
  1.  D EVN(MTYPE,EVNTTYPE)
  1.  I TYP="ILI" D
  1.  . I '$D(ERR) D PID(.RC)
  1.  . I '$D(ERR) D PV1(.RC)
  1.  . I '$D(ERR),$G(RC(8))]"" D DG1(.RC,1,RC(8))
  1.  . I '$D(ERR),$G(RC(9))]"" D DG1(.RC,2,RC(9))
  1.  . I '$D(ERR),$G(RC(10))]""  D DG1(.RC,3,RC(10))
  1.  . I '$D(ERR) D OBXMSR(.RC)
  1.  . I '$D(ERR) D ZLI(.RC)
  1.  . I '$D(ERR),$G(RC(45))]"" D ZSR(.RC,1,RC(45))
  1.  . I '$D(ERR),$G(RC(46))]"" D ZSR(.RC,2,RC(46))
  1.  . I '$D(ERR),$G(RC(47))]"" D ZSR(.RC,3,RC(47))
  1.  . I '$D(ERR),$G(RC(48))]"" D ZSR(.RC,4,RC(48))
  1.  . I '$D(ERR),$G(RC(66))]"" D ZAN(.RC)
  1.  . I $$ZPCCHK(.RC) D ZPC(.RC)
  1.  . D ZCV
  1.  . I LDA=+$G(APCLLAST) D
  1.  .. D ZHS(TYP)
  1.  .. D ZTS(TYP,LDA)
  1.  I '$D(ERR) D
  1.  .S APPARMS("SENDING APPLICATION")="RPMS-ILI"
  1.  .S APPARMS("ACCEPT ACK TYPE")="AL"
  1.  .S APPARMS("APP ACK RESPONSE")="AACK^APCLSHL"
  1.  .S APPARMS("ACCEPT ACK RESPONSE")="CACK^APCLSHL"
  1.  .S APPARMS("APP ACK TYPE")="AL"
  1.  .S APPARMS("QUEUE")="ILI ADT"
  1.  .S WHO("RECEIVING APPLICATION")="ILI"
  1.  .S WHO("FACILITY LINK NAME")="IHS"
  1.  .S WHOTO("RECEIVING APPLICATION")="IHS"
  1.  .I '$$SENDONE^HLOAPI1(.HLST,.APPARMS,.WHO,.ERR) D
  1.  .. S ERR=$G(ERR)
  1.  Q
  1.  ;
  1. AACK ; EP - Application ACK callback - called when AA, AE or AR is received.
  1.  N DATA,AACK,XQAID,XQDATA,XQA,XQAMSG,MSGID
  1.  Q:'$G(HLMSGIEN)
  1.  S MSGID=$P($G(^HLB(+HLMSGIEN,0)),U)
  1.  S AACK=$G(^HLB(HLMSGIEN,4))
  1.  I $P(AACK,U,3)'["|AA|" D
  1.  .S XQAMSG="ILI message "_MSGID_" did not receive a correct application ack."
  1.  .S XQAID="ILI,"_MSGID_","_50
  1.  .S XQDATA=$P(AACK,U,3)
  1.  .S XQA("G.APCS ILI")=""
  1.  .D SETUP^XQALERT
  1.  Q
  1.  ;
  1. CACK ; EP - Commit ACK callback - called when CA, CE or CR is received.
  1.  N CACK,XQAID,XQAMSG,XQA,XQDATA,MSGID
  1.  S MSGID=$P($G(^HLB(+HLMSGIEN,0)),U)
  1.  S CACK=$G(^HLB(HLMSGIEN,4))
  1.  I $P(CACK,U,3)'["|CA|" D
  1.  .S XQAMSG="ILI message "_MSGID_" did not receive a correct commit acknowledgement."
  1.  .S XQAID="ILI,"_MSGID_","_50
  1.  .S XQDATA=$P(CACK,U,3)
  1.  .S XQA("G.APCS ILI")=""
  1.  .D SETUP^XQALERT
  1.  Q
  1.  ;
  1. ERR ;
  1.  Q
  1.  ;
  1. EVN(MTYPE,EVNTTYPE) ;Create the EVN segment
  1.  N %,X,FLD,VAL
  1.  D NOW^%DTC
  1.  S X=$$HLDATE^HLFNC(%,"TS")
  1.  D SET(.ARY,"EVN",0)
  1.  D SET(.ARY,EVNTTYPE,1)
  1.  D SET(.ARY,X,2)
  1.  S X=$$ADDSEG^HLOAPI(.HLMSTATE,.ARY,.ERR)
  1.  Q
  1.  ; Create PID segment
  1. PID(R) ;EP
  1.  S HLQ=HL1("Q")
  1.  D SET(.ARY,"PID",0)
  1.  D SET(.ARY,1,1)
  1.  D SET(.ARY,R(1),2)
  1.  D SET(.ARY,R(2),3)  ; Patient HRN
  1.  D SET(.ARY,R(3),8)
  1.  D SET(.ARY,$$HLD(R(4)),7)
  1.  D SET(.ARY,R(5),11,8)
  1.  S X=$$ADDSEG^HLOAPI(.HLMSTATE,.ARY,.ERR)
  1.  Q
  1.  ;
  1.  ;
  1. PIDLAB(R) ;EP
  1.  D PIDLAB^APCLSIH1(R)
  1.  Q
  1.  ;
  1. ZIDLAB(R) ;
  1.  D ZIDLAB^APCLSIH1(R)
  1.  Q
  1.  ;
  1. PV1(R) ;-- setup the PV1 segment
  1.  N PRVI,PRV,LNM,FNM,MI,NPI
  1.  D SET(.ARY,"PV1",0)
  1.  D SET(.ARY,1,1)
  1.  D SET(.ARY,R(6),3,1)
  1.  D SET(.ARY,R(41),3,2)
  1.  ;add attending doctor to PV1-7 with NPI in the format NPI^LAST^FIRST^MIDDLE^^^^N
  1.  S PRVI=$G(R(138))
  1.  I $G(PRVI) D
  1.  . S NPI=$$GET1^DIQ(200,PRVI,41.99)
  1.  . S PRV=$$GET1^DIQ(200,PRVI,.01)
  1.  . D SET(.ARY,NPI,7,1)
  1.  . D SET(.ARY,"N",7,8)
  1.  D SET(.ARY,R(12),19)
  1.  D SET(.ARY,R(16),36)
  1.  D SET(.ARY,R(132),41)  ;p30 visit status
  1.  D SET(.ARY,$$HLD(R(7)),44)
  1.  D SET(.ARY,$$HLD(R(17)),45)
  1.  S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  Q
  1.  ;
  1. PV1LAB(R) ;-- setup the PV1 LAB segment
  1.  D PV1LAB^APCLSIH1(R)
  1.  Q
  1.  ;
  1. DG1(R,SQ,DG13) ;-- set the repeating DG1
  1.  N ICDT
  1.  S ICDT=$P($$ICDDX^APCLSILU(DG13,R(7)),U,20)  ;get the icd type based on the code
  1.  D SET(.ARY,"DG1",0)
  1.  D SET(.ARY,SQ,1)
  1.  D SET(.ARY,"ICD",2)
  1.  D SET(.ARY,DG13,3)
  1.  D SET(.ARY,$S(ICDT="30":"I10",1:"I9"),3,3)  ;set the diagnosis type here
  1.  S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  Q
  1.  ;
  1. DG1LAB(R) ;EP
  1.  D DG1LAB^APCLSIH1(R)
  1.  Q
  1.  ;
  1. PR1LAB(R) ;EP
  1.  D PR1LAB^APCLSIH1(R)
  1.  Q
  1.  ;
  1. OBX(R) ;-- setup the ILI OBX segment
  1.  D SET(.ARY,"OBX",0)
  1.  D SET(.ARY,1,1)
  1.  D SET(.ARY,"ST",2)
  1.  D SET(.ARY,"TMP",3)
  1.  D SET(.ARY,R(11),5)
  1.  S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  Q
  1.  ;
  1. OBXMSR(R) ;-- setup the ILI OBX HT/WT segment
  1.  N I,CNT
  1.  S CNT=0
  1.  F I=11,125,126 D
  1.  . Q:R(I)=""
  1.  . S CNT=CNT+1
  1.  . D SET(.ARY,"OBX",0)
  1.  . D SET(.ARY,CNT,1)
  1.  . D SET(.ARY,"ST",2)
  1.  . D SET(.ARY,$P(R(I),U,1),3)
  1.  . D SET(.ARY,$P(R(I),U,2),5)
  1.  . D SET(.ARY,$$HLD($P(R(I),U,3)),14)
  1.  . S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  F I=37 D
  1.  . Q:R(I)=""
  1.  . S CNT=CNT+1
  1.  . D SET(.ARY,"OBX",0)
  1.  . D SET(.ARY,CNT,1)
  1.  . D SET(.ARY,"ST",2)
  1.  . D SET(.ARY,"BMI",3)
  1.  . D SET(.ARY,$P(R(I),U,1),5)
  1.  . D SET(.ARY,$$HLD(R(38)),14)
  1.  . S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  . ;
  1.  Q
  1.  ;
  1. OBXLAB(R) ;
  1.  D OBXLAB^APCLSIH1(R)
  1.  Q
  1.  ;
  1. ZLI(R) ;-- setup the ILI ZLI segment
  1.  D SET(.ARY,"ZLI",0)
  1.  D SET(.ARY,1,1)
  1.  D SET(.ARY,$$HLD(R(14)),3)
  1.  D SET(.ARY,R(15),4)
  1.  D SET(.ARY,R(18),5)
  1.  D SET(.ARY,$$HLD(R(19)),6)
  1.  D SET(.ARY,R(21),8)
  1.  D SET(.ARY,R(22),9)
  1.  I $G(R(22))["." D
  1.  . N ICDTA
  1.  . S ICDTA=$P($$ICDDX^APCLSILU(R(22),R(7)),U,20)  ;get the icd type based on the code
  1.  . D SET(.ARY,$S(ICDTA="30":"I10",1:"I9"),9,3)
  1.  D SET(.ARY,R(33),10)
  1.  D SET(.ARY,R(34),11)
  1.  D SET(.ARY,R(35),12)
  1.  D SET(.ARY,R(36),13)
  1.  I $G(R(39))["." D  ;ihs/cmi/maw p31
  1.  . N ICDTB
  1.  . S ICDTB=$P($$ICDDX^APCLSILU(R(39),R(7)),U,20)
  1.  . D SET(.ARY,R(39),16,1)
  1.  . D SET(.ARY,$S(ICDTB="30":"I10",1:"I9"),16,3)
  1.  I $L($G(R(39)))=5,$G(R(39))'["." D
  1.  . D SET(.ARY,R(39),16,1)
  1.  . D SET(.ARY,"C4",16,3)
  1.  I $G(R(39))'[".",$L($G(R(39)))<4 D SET(.ARY,R(39),16)
  1.  D SET(.ARY,$$HLD(R(40)),17)
  1.  N ICDT
  1.  S ICDT=$P($$ICDDX^APCLSILU(R(43),R(7)),U,20)  ;get the icd type based on the code
  1.  D SET(.ARY,R(43),19)
  1.  I $G(R(43))]"" D SET(.ARY,$S(ICDT="30":"I10",1:"I9"),19,3)
  1.  D SET(.ARY,R(44),20)
  1.  D SET(.ARY,R(59),21)
  1.  D SET(.ARY,R(60),22)
  1.  D SET(.ARY,R(61),23)
  1.  D SET(.ARY,R(62),24)
  1.  D SET(.ARY,R(63),25)
  1.  D SET(.ARY,R(64),26)
  1.  D SET(.ARY,R(65),27)
  1.  D SET(.ARY,$$HLD(R(123)),28)
  1.  D SET(.ARY,$$HLD(R(124)),29)
  1.  D SET(.ARY,R(133),30)
  1.  D SET(.ARY,R(134),31)
  1.  D SET(.ARY,R(135),32)
  1.  D SET(.ARY,$$HLD(R(136)),33)
  1.  S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  Q
  1.  ;
  1. ZPCCHK(R) ;-- do we need to create a ZPC
  1.  I R(107) Q 1
  1.  F I=113:1:122 I R(I) Q 1
  1.  Q 0
  1.  ;
  1. ZPC(R) ;-- setup the ZPC segment
  1.  D SET(.ARY,"ZPC",0)
  1.  D SET(.ARY,R(107),1)
  1.  D SET(.ARY,R(113),2)
  1.  N ICDT
  1.  S ICDT=$P($$ICDDX^APCLSILU(R(113),R(7)),U,20)  ;get the icd type based on the code
  1.  I $G(R(113))]"" D SET(.ARY,$S(ICDT="30":"I10",1:"I9"),2,3)
  1.  D SET(.ARY,$$HLD(R(114)),3)
  1.  D SET(.ARY,R(115),4)
  1.  N ICDTA
  1.  S ICDTA=$P($$ICDDX^APCLSILU(R(115),R(7)),U,20)  ;get the icd type based on the code
  1.  I $G(R(115))]"" D SET(.ARY,$S(ICDTA="30":"I10",1:"I9"),4,3)
  1.  D SET(.ARY,$$HLD(R(116)),5)
  1.  D SET(.ARY,R(117),6)
  1.  N ICDTB
  1.  S ICDTB=$P($$ICDDX^APCLSILU(R(117),R(7)),U,20)  ;get the icd type based on the code
  1.  I $G(R(117))]"" D SET(.ARY,$S(ICDTB="30":"I10",1:"I9"),6,3)
  1.  D SET(.ARY,$$HLD(R(118)),7)
  1.  D SET(.ARY,R(119),8)
  1.  N ICDTC
  1.  S ICDTC=$P($$ICDDX^APCLSILU(R(119),R(7)),U,20)  ;get the icd type based on the code
  1.  I $G(R(119))]"" D SET(.ARY,$S(ICDTC="30":"I10",1:"I9"),8,3)
  1.  D SET(.ARY,$$HLD(R(120)),9)
  1.  D SET(.ARY,R(121),10)
  1.  N ICDTD
  1.  S ICDTD=$P($$ICDDX^APCLSILU(R(121),R(7)),U,20)  ;get the icd type based on the code
  1.  I $G(R(121))]"" D SET(.ARY,$S(ICDTD="30":"I10",1:"I9"),10,3)
  1.  D SET(.ARY,$$HLD(R(122)),11)
  1.  S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  Q
  1.  ;
  1. ZAV(R,SQ,ZAV2,ZAV3) ;-- setup the ILI ZAV segment
  1.  D SET(.ARY,"ZAV",0)
  1.  D SET(.ARY,SQ,1)
  1.  D SET(.ARY,$$HLD(ZAV2),2)
  1.  D SET(.ARY,ZAV3,3)
  1.  S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  Q
  1.  ;
  1. ZSR(R,SQ,ZSR2) ;-- setup the ILI ZSR segment
  1.  N ICDT
  1.  S ICDT=$P($$ICDDX^APCLSILU(ZSR2,R(7)),U,20)  ;get the icd type based on the code
  1.  D SET(.ARY,"ZSR",0)
  1.  D SET(.ARY,SQ,1)
  1.  D SET(.ARY,ZSR2,2)
  1.  D SET(.ARY,$S(ICDT="30":"I10",1:"I9"),2,3)  ;set the diagnosis type here
  1.  S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  Q
  1.  ;
  1. ZAE(R,SQ,ZAE2) ;-- setup the ILI ZAE segment
  1.  D SET(.ARY,"ZAE",0)
  1.  D SET(.ARY,SQ,1)
  1.  D SET(.ARY,ZAE2,2)
  1.  S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  Q
  1.  ;
  1. ZAS(R,SQ,ZAS2,ZAS3) ;-- setup the ILI ZAS segment
  1.  D SET(.ARY,"ZAS",0)
  1.  D SET(.ARY,SQ,1)
  1.  D SET(.ARY,ZAS2,2)
  1.  D SET(.ARY,$$HLD(ZAS3),3)
  1.  S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  Q
  1.  ;
  1. ZAN(R) ;-- setup the ILI ZAN segment
  1.  N I,ZANC,VAL,VALD
  1.  S ZANC=1
  1.  F I=66:1:70 D
  1.  . I $G(R(I))]"" D
  1.  .. S VAL=$G(R(I))
  1.  .. S VALD=$$FMTHL7^XLFDT($G(R(I+42)))
  1.  .. D SET(.ARY,"ZAN",0)
  1.  .. D SET(.ARY,ZANC,1)
  1.  .. N ICDT
  1.  .. S ICDT=$P($$ICDDX^APCLSILU(VAL,R(7)),U,20)  ;get the icd type based on the code
  1.  .. D SET(.ARY,VAL,2)
  1.  .. D SET(.ARY,$S(ICDT="30":"I10",1:"I9"),2,3)
  1.  .. D SET(.ARY,VALD,3)
  1.  .. S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  .. S ZANC=ZANC+1
  1.  Q
  1.  ;
  1. ZCV(R) ;-- setup the ILI ZCV segment
  1.  N J,ZCVC,VALC,VALD,ARBD,X,D
  1.  S ZCVC=0
  1.  S J=0 F  S J=$O(^AUPNVIMM("AC",DFN,J)) Q:J'=+J  D
  1.  . Q:'$D(^AUPNVIMM(J,0))  ;bad xref
  1.  . Q:$P(^AUPNVIMM(J,0),U,1)=""
  1.  . S VALD=""
  1.  . I $P($G(^AUPNVIMM(J,12)),U,1) S VALD=$P($P(^AUPNVIMM(J,12),U,1),".")
  1.  . I VALD="" S VALD=$$VD^APCLV($P(^AUPNVIMM(J,0),U,3))
  1.  . S VALC=$$GET1^DIQ(9999999.14,$P(^AUPNVIMM(J,0),U,1),.03)
  1.  . S ARBD(9999999-VALD,J)=VALC
  1.  S D=0 F  S D=$O(ARBD(D)) Q:D'=+D  D
  1.  .S J=0 F  S J=$O(ARBD(D,J)) Q:J'=+J  D
  1.  .. S VALD=$$FMTHL7^XLFDT(9999999-D),VALC=ARBD(D,J),ZCVC=ZCVC+1
  1.  .. D SET(.ARY,"ZCV",0)
  1.  .. D SET(.ARY,ZCVC,1)
  1.  .. D SET(.ARY,VALC,2)
  1.  .. D SET(.ARY,VALD,3)
  1.  .. S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
  1.  Q
  1.  ;
  1.  ; Create MSA segment
  1. MSA ;EP
  1.  N MSA
  1.  D SET(.ARY,"MSA",0)
  1.  D SET(.ARY,"AA",1)
  1.  D SET(.ARY,"TODO-MSGID",2)
  1.  D SET(.ARY,"Transaction Successful",3)
  1.  S MSA=$$ADDSEG^HLOAPI(.HLST,.ARY)
  1.  Q
  1.  ; Create MSH segment
  1.  ;EP
  1.  N MSH
  1.  D SET(.ARY,"MSH",0)
  1.  S MSH=$$ADDSEG^HLOAPI(.HLST,.ARY)
  1.  Q
  1. SET(ARY,V,F,C,S,R) ;EP
  1.  D SET^HLOAPI(.ARY,.V,.F,.C,.S,.R)
  1.  Q
  1. FIXZIP(DFN,ZIP) ;EP
  1.  Q:$G(ZIP) ZIP
  1.  Q $$GET1^DIQ(2,DFN,.116)
  1.  ;
  1. HLD(FDT) ;-- convert to HL7 date
  1.  I $G(FDT)="" Q ""
  1.  N D
  1.  S %DT="X"
  1.  S X=FDT D ^%DT
  1.  S D=$$FMTHL7^XLFDT(Y)
  1.  Q D
  1.  ;
  1. GL(IN,TYP) ;-- write out batch
  1.  K ^APCLTMP($J)
  1.  N BDA,BDO,HLODAT,MSH,MSGP,MSG,BT,BT1,BT2,BT3
  1.  S APCLCNT=0
  1.  S MSG=$P($G(^HLB(IN,0)),U,2)
  1.  S BT1=$G(^HLB(IN,1))
  1.  S BT2=$G(^HLB(IN,2))
  1.  S BT3=$G(^HLB(IN,3))
  1.  S BT=BT1_BT2_BT3
  1.  D SETGL(BT)
  1.  S BDA=0 F  S BDA=$O(^HLB(IN,3,BDA)) Q:'BDA  D
  1.  . S MSH=""
  1.  . S MSGP=$P($G(^HLB(IN,3,BDA,0)),U)
  1.  . S BDO=0 F  S BDO=$O(^HLB(IN,3,BDA,BDO)) Q:'BDO  D
  1.  .. S HLOMSH=$G(^HLB(IN,3,BDA,BDO))
  1.  .. S MSH=MSH_HLOMSH
  1.  . D SETGL(MSH)
  1.  . D REST(MSG,MSGP)
  1.  S DIK="^HLB(",DA=IN D ^DIK
  1.  S DIK="^HLA(",DA=MSG D ^DIK
  1.  D WRITE(TYP)
  1.  Q
  1.  ;
  1. REST(M,MP) ;-- write out the remainder of the segments to the global
  1.  N MDA,DATA,MCNT
  1.  S MCNT=0
  1.  S MDA=0 F  S MDA=$O(^HLA(M,2,MP,1,MDA)) Q:'MDA  D
  1.  . S DATA=$G(^HLA(M,2,MP,1,MDA,0))
  1.  . Q:DATA=""
  1.  . D SETGL(DATA)
  1.  Q
  1.  ;
  1. SETGL(D) ;-- set the temp global
  1.  S APCLCNT=APCLCNT+1
  1.  S ^APCLTMP($J,APCLCNT)=D
  1.  Q
  1.  ;
  1. WRITE(T) ; use XBGSAVE to save the temp global (APCLDATA) to a delimited
  1.  N XBGL,XBQ,XBQTO,XBNAR,XBMED,XBFLT,XBUF,XBFN,APCLFN
  1.  S XBGL="APCLTMP",XBMED="F",XBQ="N",XBFLT=1,XBF=$J,XBE=$J
  1.  S XBNAR="ILI FLU "_TYP_"_HL7 EXPORT"
  1.  S APCLASU=$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U),0)),U,10)
  1.  ;is this a test system?
  1.  NEW TST
  1.  S TST=0
  1.  I $P($G(^APCLILIC(1,0)),U,5)="T" S TST=1
  1.  S (XBFN,APCLDFN)=$S(TST:"FLZ",$G(APCLFLF):"FLF",$G(APCLFLFN):"FLF",1:"FLU")_"_"_APCLASU_"_"_$$DATE(DT)_"_P31.txt"  ;IHS/CMI/LAB - PATCH 31 FILENAME AND PATCH #
  1.  S XBS1="SURVEILLANCE ILI SEND"
  1.  ;
  1.  D ^XBGSAVE
  1.  ;
  1.  I XBFLG'=0 D
  1.  . I XBFLG(1)="" W:'$D(ZTQUEUED) !!,TYP_" HL7 file successfully created",!!
  1.  . I XBFLG(1)]"" W:'$D(ZTQUEUED) !!,TYP_" HL7 file NOT successfully created",!!
  1.  . W:'$D(ZTQUEUED) !,"File was NOT successfully transferred to IHS/CDC",!,"you will need to manually ftp it.",!
  1.  . W:'$D(ZTQUEUED) !,XBFLG(1),!!
  1.  D SETLOG
  1.  K ^APCLTMP($J),APCLCNT
 K ^APCLDATA($J)

 Q

DATE(D) ;EP

 Q (1700+$E(D,1,3))_$E(D,4,5)_$E(D,6,7)

 ;

SETLOG ;EP

 D SET^APCLSIL4

 Q