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

BDWBHL.m

Go to the documentation of this file. 
  1. BDWBHL ; IHS/CMI/LAB - BDW Populate Various DW1 HL7 Segments ; [ 04/05/2007  2:56 PM ]
  1.  ;;1.0;IHS DATA WAREHOUSE;**1,2,4**;JAN 23, 2006;Build 24
  1.  ;       
  1.  ;this routine will set up all of the necessary variables to populate varios DW1 HL7 segments
  1.  ;
  1.  ;cmi/anch/maw 4/5/2007 added hard code of EXO in HDR
  1.  ;
  1. MAIN ;EP - this is the main routine driver
  1.  S INQUE=1
  1.  D ZVP,DG1,PR1,ZDN,ZIM,ZMD,HF,MSR,XAM,CPT,LAB,PED,SKT,IFC
  1.  Q
  1.  ;
  1. ZVP ;EP - populate the dw1 ZVP segment
  1.  K PRV
  1.  S BDWCNT=0
  1.  D PROV^BDWUTIL1(.PRV,BHLVIEN)
  1.  I $G(PRV(1))="" D
  1.  . S BDWCNT=1,INDA("ZVP",BDWCNT)="",INA("BDW1ZVP1",BDWCNT)=BDWCNT
  1.  S BDWDA=0 F  S BDWDA=$O(PRV(BDWDA)) Q:'BDWDA  D
  1.  . S BDWDATA=$G(PRV(BDWDA))
  1.  . S BDWCNT=BDWCNT+1
  1.  . S INDA("ZVP",BDWCNT)=""
  1.  . S INA("BDW1ZVP1",BDWCNT)=BDWCNT
  1.  . S INA("BDW1ZVP2",BDWCNT)=$P(BDWDATA,U,3)
  1.  . S INA("BDW1ZVP3",BDWCNT)=$P(BDWDATA,U,4)
  1.  . S INA("BDW1ZVP4",BDWCNT)=$P(BDWDATA,U,6)
  1.  . S INA("BDW1ZVP5",BDWCNT)=$P(BDWDATA,U,7)
  1.  . S INA("BDW1ZVP6",BDWCNT)=$P(BDWDATA,U,8)
  1.  . S INA("BDW1ZVP7",BDWCNT)=$P(BDWDATA,U,5)
  1.  K BDWDA,BDWCNT,BDWDATA,PRV
  1.  Q
  1.  ;
  1. DG1 ;EP - populate the dw1 DG1 and ZDX segments
  1.  K POV
  1.  S BDWCNT=0
  1.  D POVS^BDWUTIL(.POV,BHLVIEN)
  1.  S BDWDA=0 F  S BDWDA=$O(POV(BDWDA)) Q:'BDWDA  D
  1.  . S BDWDATA=$G(POV(BDWDA))
  1.  . S BDWCNT=BDWCNT+1
  1.  . S INDA("DG1",BDWCNT)=""
  1.  . S INA("BDW1DG11",BDWCNT)=BDWCNT
  1.  . ;ihs/cmi/maw 06/10/2014 p5 ALPMR added provider narrative to DG1-3
  1.  . S INA("BDW1DG13",BDWCNT)=$P(BDWDATA,U)_U_U_$P(BDWDATA,U,10)  ;ihs/cmi/maw 10/17/2012 patch 4 icd10
  1.  . S INA("BDW1ZDX1",BDWCNT,1)=$P(BDWDATA,U,12)
  1.  . S INA("BDW1ZDX4",BDWCNT,1)=$P(BDWDATA,U,2)
  1.  . S INA("BDW1ZDX6",BDWCNT,1)=$P(BDWDATA,U,3)_U_U_$P(BDWDATA,U,11)  ;ihs/cmi/maw 10/17/2012 patch 4 icd10
  1.  . S INA("BDW1ZDX7",BDWCNT,1)=$P(BDWDATA,U,4)
  1.  S INDA("ZDX",1)=""
  1.  K BDWCNT,BDWDA,BDWDATA,POV
  1.  Q
  1.  ;
  1. PR1 ;EP - populate the dw1 PR1 and ZPR segments
  1.  K PRC
  1.  N PFLG
  1.  S BDWCNT=0
  1.  D PROC^BDWUTIL1(.PRC,BHLVIEN)
  1.  S BDWDA=0 F  S BDWDA=$O(PRC(BDWDA)) Q:'BDWDA  D
  1.  . S BDWDATA=$G(PRC(BDWDA))
  1.  . S BDWCNT=BDWCNT+1
  1.  . S INDA("PR1",BDWCNT)=""
  1.  . S INA("BDW1PR11",BDWCNT)=BDWCNT
  1.  . S INA("BDW1PR13",BDWCNT)=$P(BDWDATA,U)_U_U_$P(BDWDATA,U,10)  ;ihs/cmi/maw 10/17/2012 patch 4 icd10
  1.  . S INA("BDW1PR15",BDWCNT)=$$DATE^INHUT($P(BDWDATA,U,2))
  1.  . S INA("BDW1PR111",BDWCNT)=$P(BDWDATA,U,4)
  1.  . S INA("BDW1ZPR5",BDWCNT,1)=$P(BDWDATA,U,3)
  1.  . S INA("BDW1ZPR8",BDWCNT,1)=$P(BDWDATA,U,6)
  1.  . S INA("BDW1ZPR9",BDWCNT,1)=$P(BDWDATA,U,5)
  1.  . S INA("BDW1ZPR10",BDWCNT,1)=$P(BDWDATA,U,7)
  1.  . S INA("BDW1ZPR11",BDWCNT,1)=$P(BDWDATA,U,8)
  1.  . S INA("BDW1ZPR12",BDWCNT,1)=$P(BDWDATA,U,9)
  1.  . S INA("BDW1ZPR13",BDWCNT,1)=$P(BDWDATA,U,13)
  1.  . S PFLG=$$CHKPFLG(BDWDATA)
  1.  . S INA("BDW1ZPR13",BDWCNT,1)=$TR(INA("BDW1ZPR13",BDWCNT,1),"!","^")
  1.  . I $G(PFLG) S INDA("ZPR",BDWCNT,1)="",INDA("ZPR",BDWCNT)=""
  1.  K BDWCNT,BDWDA,BDWDATA,PRC
  1.  Q
  1.  ;
  1. CHKPFLG(DATA) ;check to see if we do a ZPR segment
  1.  N I,FL
  1.  S FL=0
  1.  F I=3,5,6,7,8,9,13 D
  1.  . I $P(DATA,U,I)]"" S FL=1
  1.  Q FL
  1.  ;
  1. ZDN ;EP - populate the dw1 ZDN and ZDP segments
  1.  K DEN
  1.  S BDWCNT=0
  1.  D DENT^BDWUTIL(.DEN,BHLVIEN)
  1.  S BDWDA=0 F  S BDWDA=$O(DEN(BDWDA)) Q:'BDWDA  D
  1.  . S BDWDATA=$G(DEN(BDWDA))
  1.  . S BDWCNT=BDWCNT+1
  1.  . S INDA("ZDN",BDWCNT)=""
  1.  . S INDA("ZDP",BDWCNT)=""
  1.  . S INA("BDW1ZDN1",BDWCNT)=BDWCNT
  1.  . S INA("BDW1ZDN2",BDWCNT)=$P(BDWDATA,U)
  1.  . S INA("BDW1ZDN3",BDWCNT)=$P(BDWDATA,U,2)
  1.  . S INA("BDW1ZDN4",BDWCNT)=$P(BDWDATA,U,3)
  1.  . S INA("BDW1ZDN5",BDWCNT)=$P(BDWDATA,U,4)
  1.  . S INA("BDW1ZDN6",BDWCNT)=$P(BDWDATA,U,8)
  1.  . S INA("BDW1ZDN7",BDWCNT)=$P(BDWDATA,U,5)
  1.  . S INA("BDW1ZDP1",BDWCNT)=BDWCNT
  1.  . S INA("BDW1ZDP2",BDWCNT)=$P(BDWDATA,U,6)
  1.  . S INA("BDW1ZDP3",BDWCNT)=$P(BDWDATA,U,7)
  1.  K BDWCNT,BDWDA,BDWDATA,DEN
  1.  Q
  1.  ;
  1. ZIM ;EP - populate the dw1 ZIM segment
  1.  D ZIM^BDWBHL1
  1.  Q
  1.  ;
  1. ZMD ;EP - populate the dw1 ZMD segment
  1.  K MED
  1.  S BDWCNT=0
  1.  D MED^BDWUTIL1(.MED,BHLVIEN)
  1.  S BDWDA=0 F  S BDWDA=$O(MED(BDWDA)) Q:'BDWDA  D
  1.  . S BDWDATA=$G(MED(BDWDA))
  1.  . S BDWCNT=BDWCNT+1
  1.  . S INDA("ZMD",BDWCNT)=""
  1.  . S INA("BDW1ZMD1",BDWCNT)=BDWCNT
  1.  . S INA("BDW1ZMD2",BDWCNT)=$P(BDWDATA,U)
  1.  . S INA("BDW1ZMD3",BDWCNT)=$P(BDWDATA,U,3)
  1.  . S INA("BDW1ZMD4",BDWCNT)=$P(BDWDATA,U,4)
  1.  . S INA("BDW1ZMD5",BDWCNT)=$P(BDWDATA,U,2)
  1.  K BDWCNT,BDWDA,BDWDATA,MED
  1.  Q
  1.  ;
  1. HF ;EP - populate the dw1 OBX health factors segment
  1.  D HF^BDWBHL1
  1.  Q
  1.  ;
  1. MSR ;EP - populate the dw1 OBX measurement segment
  1.  D MSR^BDWBHL1
  1.  Q
  1.  ;
  1. XAM ;EP - populate the dw1 OBX exam segment
  1.  D XAM^BDWBHL1
  1.  Q
  1.  ;
  1. CPT ;-- populate the dw1 CPT exam segment
  1.  D CPT^BDWBHL1
  1.  Q
  1.  ;
  1. LAB ;-- populate the dw1 OBX lab segment
  1.  D LAB^BDWBHL1
  1.  Q
  1.  ;
  1. PED ;EP - populate the dw1 OBX patient education segment
  1.  D PED^BDWBHL1
  1.  Q
  1.  ;
  1. SKT ;EP - populate the dw1 OBX skin test segment
  1.  D SKT^BDWBHL1
  1.  Q
  1.  ;
  1. IFC ;EP - populate the dw1 OBX infant feeding choice segment
  1.  D IFC^BDWBHL1
  1.  Q
  1.  ;
  1. ZRC ;EP - generate ZRC segment
  1.  S INQUE=1
  1.  K INDA("ZRC")
  1.  S BDWCNT=0
  1.  S BDWDA=0 F  S BDWDA=$O(^AUPNPAT(DFN,41,BDWDA)) Q:'BDWDA  D
  1.  . S BDWCNT=BDWCNT+1
  1.  . S BDWDATA=$G(^AUPNPAT(DFN,41,BDWDA,0))
  1.  . I $P(BDWDATA,U)="" S BDWDATA=BDWDA_BDWDATA
  1.  . Q:$P($G(^AGFAC($P(BDWDATA,U),0)),U,21)'="Y"
  1.  . S INDA("ZRC",BDWCNT)=""
  1.  . S INA("BDW1ZRC6",BDWCNT)=$S($P(BDWDATA,U):$P($G(^AUTTLOC($P(BDWDATA,U),0)),U,10),1:"")
  1.  . S INA("BDW1ZRC7",BDWCNT)=$P(BDWDATA,U,2)
  1.  . S INA("BDW1ZRC8",BDWCNT)=$P(BDWDATA,U,5)
  1.  K BDWCNT,BDWDA
  1.  Q
  1.  ;
  1. ZRL ;EP - generate ZRL segment
  1.  K INDA("ZRL")
  1.  S BDWCNT=0
  1.  S BDWDA=0 F  S BDWDA=$O(^DPT(DFN,.01,BDWDA)) Q:'BDWDA  D
  1.  . S BDWDATA=$P($G(^DPT(DFN,.01,BDWDA,0)),U)
  1.  . S BDWCNT=BDWCNT+1
  1.  . S BDWALNM=$P(BDWDATA,",")
  1.  . S BDWAFNM=$P($P(BDWDATA,",",2)," ")
  1.  . S BDWAMI=$P($P(BDWDATA,",",2)," ",2)
  1.  . S BDWASTR=BDWALNM_U_BDWAFNM_U_BDWAMI
  1.  . S INDA("ZRL",BDWCNT)=""
  1.  . S INA("BDW1ZRL6",BDWCNT)=BDWASTR
  1.  K BDWDA,BDWCNT,BDWALNM,BDWAFNM,BDWAMI,BDWASTR
  1.  Q
  1.  ;
  1. HDR ;-- generate the header record
  1.  S INQUE=1
  1.  NEW BDWDEST S BDWDEST=$O(^INRHD("B","HL IHS DW1 IE",0)) K ^INLHDEST(BDWDEST) ;IHS/CMI/LAB - kill at beginning of each batch
  1.  ;cmi/anch/maw 3/7/2007 added the following 3 lines for common header vars
  1.  S INA("BDW1ZHS4")="HL7"
  1.  I $G(INA("FILE")) S INA("BDW1ZHS5")="EXO^"_$$GET1^DIQ(INA("FILE"),INDA,.23)  ;cmi/anch/maw 3/7/2007 for desc of option ran
  1.  S INA("BDW1ZHS6")="2.4"  ;change this when version changes
  1.  I INA("FILE")=90215 D  Q
  1.  . S INA("BDW1BHS7")=$$DATE^INHUT($$GET1^DIQ(90215,INDA,.01),1)
  1.  . S INA("BDW1BHS9")=INDA
  1.  . S INA("BDW1BHS11")=$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U),0)),U,10)_INDA
  1.  . S (INA("BDW1ZHS1"),INA("BDW1ZHS2"))=$$DATE^INHUT($$GET1^DIQ(90215,INDA,.01,"I"))
  1.  . S INA("BDW1ZHS3")=INDA
  1.  I INA("FILE")=90213 D  Q
  1.  . S INA("BDW1BHS7")=$$DATE^INHUT($$GET1^DIQ(90213,INDA,.01,"I"),1)
  1.  . S INA("BDW1BHS9")=INDA
  1.  . S INA("BDW1BHS11")=$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U),0)),U,10)_INDA
  1.  . S INA("BDW1ZHS1")=$$DATE^INHUT($$GET1^DIQ(90213,INDA,.01,"I"))
  1.  . S INA("BDW1ZHS2")=$$DATE^INHUT($$GET1^DIQ(90213,INDA,.02,"I"))
  1.  . S INA("BDW1ZHS3")=INDA
  1.  . S INA("BDW1ZHS3")=INDA
  1.  I INA("FILE")=90214 D  Q
  1.  . S INA("BDW1BHS7")=$$DATE^INHUT($$GET1^DIQ(90214,INDA,.03,"I"),1)
  1.  . S INA("BDW1BHS9")=INDA
  1.  . S INA("BDW1BHS11")=$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U),0)),U,10)_INDA
  1.  . S INA("BDW1ZHS1")=$$DATE^INHUT($$GET1^DIQ(90214,INDA,.01,"I"))
  1.  . S INA("BDW1ZHS2")=$$DATE^INHUT($$GET1^DIQ(90214,INDA,.02,"I"))
  1.  . S INA("BDW1ZHS3")=INDA
  1.  Q
  1.  ;
  1. TRL ;-- generate the trailer record
  1.  S INQUE=1
  1.  I INA("FILE")=90214 D  Q
  1.  . S INA("BDW1ZTS1")=$$GET1^DIQ(90214,INDA,.18)
  1.  . S INA("BDW1ZTS2")=$$GET1^DIQ(90214,INDA,.05)
  1.  . S INA("BDW1ZTS3")=(INA("BDW1ZTS2")-$$GET1^DIQ(90214,INDA,3101))
  1.  . S INA("BDW1ZTS4")=$$GET1^DIQ(90214,INDA,3101)
  1.  . S INA("BDW1ZTS5")=$$GET1^DIQ(90214,INDA,.06)+2
  1.  . S INA("BDW1BTS1")=$$GET1^DIQ(90214,INDA,.06)
  1.  . S INA("BDW1BTS2")=$P($G(^DIC(4,$P(^AUTTSITE(1,0),U),0)),U)
  1.  . S INA("BDW1BTS3")=1
  1.  . D HFS  ;task to host file
  1.  I INA("FILE")=90213 D  Q
  1.  . S INA("BDW1ZTS1")=$$GET1^DIQ(90213,INDA,.18)
  1.  . S INA("BDW1ZTS2")=$$GET1^DIQ(90213,INDA,.05)
  1.  . S INA("BDW1ZTS3")=(INA("BDW1ZTS2")-$$GET1^DIQ(90213,INDA,3101))
  1.  . S INA("BDW1ZTS4")=$$GET1^DIQ(90213,INDA,3101)
  1.  . S INA("BDW1ZTS5")=$$GET1^DIQ(90213,INDA,.06)+2
  1.  . S INA("BDW1BTS1")=$$GET1^DIQ(90213,INDA,.06)
  1.  . S INA("BDW1BTS2")=$P($G(^DIC(4,$P(^AUTTSITE(1,0),U),0)),U)
  1.  . S INA("BDW1BTS3")=1
  1.  . N BDWDA,BDWC S BDWC=0
  1.  . S BDWDA=0 F  S BDWDA=$O(^BDWXLOG(INDA,99,BDWDA)) Q:'BDWDA  D
  1.  .. S BDWC=BDWC+1
  1.  .. S INDA("NTE",BDWC)=""
  1.  .. S INA("BDW1NTE3",BDWC)=$G(^BDWXLOG(INDA,99,BDWDA,0))
  1.  . D HFS  ;task to host file
  1.  I INA("FILE")=90215 D  Q
  1.  . S INA("BDW1ZTS5")=$$GET1^DIQ(90215,INDA,.05)+2
  1.  . S INA("BDW1BTS1")=$$GET1^DIQ(90215,INDA,.05)
  1.  . S INA("BDW1BTS2")=$P($G(^DIC(4,$P(^AUTTSITE(1,0),U),0)),U)
  1.  . S INA("BDW1BTS3")=1
  1.  . D HFS  ;task to host file
  1.  Q
  1.  ;
  1. BQ(BHLP) ;-- return blood quantum
  1.  K BHLPVAL
  1.  N BHLX,BHLY
  1.  S (BHLX,BHLY)=""
  1.  S BHLPVAL=""
  1.  S BHLPVAL=$P($G(^AUPNPAT(BHLP,11)),U,10)
  1.  I +BHLPVAL>0 S BHLX=$P(BHLPVAL,"/",1)/$P(BHLPVAL,"/",2)
  1.  S BHLY=$S((BHLPVAL="FULL"!(BHLX=1)):1,BHLPVAL="NONE":5,BHLPVAL="UNSPECIFIED":6,BHLPVAL="UNKNOWN":7,+BHLPVAL'>0:7,1:BHLY)
  1.  I BHLY]"" Q $G(BHLY)
  1.  S BHLY=$S(BHLX'<.5:2,BHLX'<.25:3,BHLX'<.125:4,BHLX<.125:4,1:BHLY)
  1.  Q $G(BHLY)
  1.  ;
  1. FLG(BDWSEG,BDWIEN) ;EP -- return status flag based on segment
  1.  I $G(INA("BACKLOAD")) Q "A"
  1.  NEW G,X
  1.  S G=0 F X=1:1:5 I $P($G(^AUPNPAT(BDWIEN,4)),U,X)]"" S G=1
  1.  I 'G Q "A"
  1.  N BDWFLG
  1.  S BDWCD="N",BDWFLG=0
  1.  I '$G(^AUPNPAT(BDWIEN,4)) S BDWFLG=1
  1.  I BDWSEG="ZRB" D  Q $G(BDWCD)
  1.  . I $P($G(^AUPNPAT(BDWIEN,4)),U)="" S BDWFLG=1
  1.  . I $P($G(^AUPNDWAF(BDWIEN,0)),U,2)]"",BDWFLG=1 S BDWCD="A"
  1.  . I $P($G(^AUPNDWAF(BDWIEN,0)),U,2)]"",BDWFLG=0 S BDWCD="Y"
  1.  I BDWSEG="ZRL" D  Q $G(BDWCD)
  1.  . I $P($G(^AUPNPAT(BDWIEN,4)),U)="",$P($G(^AUPNPAT(BDWIEN,4)),U,3)="" S BDWFLG=1
  1.  . I $P($G(^AUPNDWAF(BDWIEN,0)),U,6)]"",BDWFLG=1 S BDWCD="A"
  1.  . I $P($G(^AUPNDWAF(BDWIEN,0)),U,6)]"",BDWFLG=0 S BDWCD="Y"
  1.  I BDWSEG="ZRC" D  Q $G(BDWCD)
  1.  . I $P($G(^AUPNPAT(BDWIEN,4)),U)="",$P($G(^AUPNPAT(BDWIEN,4)),U,4)="" S BDWFLG=1
  1.  . I $P($G(^AUPNDWAF(BDWIEN,0)),U,8)]"",BDWFLG=1 S BDWCD="A"
  1.  . I $P($G(^AUPNDWAF(BDWIEN,0)),U,8)]"",BDWFLG=0 S BDWCD="Y"
  1.  I BDWSEG="ZRD" D  Q $G(BDWCD)
  1.  . I $P($G(^AUPNPAT(BDWIEN,4)),U)="",$P($G(^AUPNPAT(BDWIEN,4)),U,2)="" S BDWFLG=1
  1.  . I $P($G(^AUPNDWAF(BDWIEN,0)),U,4)]"",BDWFLG=1 S BDWCD="A"
  1.  . I $P($G(^AUPNDWAF(BDWIEN,0)),U,4)]"",BDWFLG=0 S BDWCD="Y"
  1.  I BDWSEG="ZIN" D  Q $G(BDWCD)
  1.  . I $P($G(^AUPNPAT(BDWIEN,4)),U)="",$P($G(^AUPNPAT(BDWIEN,4)),U,5)="" S BDWFLG=1
  1.  . I $P($G(^AUPNDWAF(BDWIEN,0)),U,11)]"",BDWFLG=1 S BDWCD="A"
  1.  . I $P($G(^AUPNDWAF(BDWIEN,0)),U,11)]"",BDWFLG=0 S BDWCD="Y"
  1.  Q BDWCD
  1.  ;
  1. GETDIR ;get export directory
  1.  S BDWHDIR=$S($P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:$G(^XTV(8989.3,1,"DEV")))
  1.  I $G(BDWHDIR)="" S BDWHDIR="/usr/spool/uucppublic/"
  1.  Q
  1. HFSA(DEST,BHLHDIR,BHLHFNM) ;EP - export from this destination
  1.  S Y=$$OPEN^%ZISH(BHLHDIR,BHLHFNM,"W")
  1.  Q:Y
  1.  S BHLX=0 F  S BHLX=$O(^BDWTMP(DEST,BHLX)) Q:'BHLX  D
  1.  . S BHLU=$O(^INTHU("AT",BHLX,0))
  1.  . Q:'BHLU  ;cmi/maw 6/28/2004 added for null node
  1.  . D LPINTHU(BHLU)
  1.  D ^%ZISC
  1.  ;*****LORI PUT SENDTO HERE WHEN READY
  1.  I $P($G(^AUTTSITE(1,0)),U,21)=1 S BDWSLASH="/" I 1
  1.  E  S BDWSLASH="\"
  1.  S BDWNOSLA=1 I $E(BDWHDIR,$L(BDWHDIR))="/"!($E(BDWHDIR,$L(BDWHDIR))="\") S BDWNOSLA=0
  1.  S BDWPAFN=BHLHDIR_$S(BDWNOSLA:BDWSLASH,1:"")_BHLHFNM
  1.  ;now loop through and delete them
  1.  S BHLX=0 F  S BHLX=$O(^BDWTMP(DEST,BHLX)) Q:'BHLX  D
  1.  .S BHLU=$O(^INTHU("AT",BHLX,0))
  1.  .Q:'BHLU  ;cmi/maw 6/28/2004 added for null node
  1.  .S DA=BHLU,DIE="^INTHU(",DR=".03////C" D ^DIE K DIE,DA,DR
  1.  .Q
  1.  K ^BDWTMP(DEST)
  1.  D AUTOSEND^BDWBHL1
  1. FTP ;
  1.  ;PUT FTP TO DW MACHINE HERE
  1. BULL ;now send mailman message to user who queued the job
  1.  D BULL^BDWBHL1
  1.  Q
  1.  ;
  1. LPINTHU(BHLUIEN)       ;EP - loop through UIF and set to file
  1.  S BHLUDA=0 F  S BHLUDA=$O(^INTHU(BHLUIEN,3,BHLUDA)) Q:'BHLUDA  D
  1.  . U IO W $P($G(^INTHU(BHLUIEN,3,BHLUDA,0)),"|CR|"),!
  1.  Q
  1.  ;
  1. DELAY(IDA,IA) ;-- determine the delay based on records
  1.  I IA=90215 Q 60
  1.  N BDWRCNT
  1.  S BDWRCNT=$$GET1^DIQ(IA,IDA,.06)
  1.  I BDWRCNT>10000 Q 30
  1.  I BDWRCNT>40000 Q 60
  1.  I BDWRCNT>60000 Q 90
  1.  Q 15
  1.  ;
  1. HFS ;-- task the file to the host system
  1.  NEW BDWUSER,BDWDESC,F,BDWPFL,BDWPIEN
  1.  S BDWUSER=$$VALI^XBDIQ1(INA("FILE"),INDA,8801)
  1.  S BDWPFL=$G(INA("FILE"))  ;maw added 4/7/2005  for ZTS-6
  1.  S BDWPIEN=$G(INDA)  ;maw added 4/7/2005 for ZTS-6
  1.  I INA("FILE")=90213 S BDWDESC="Data Warehouse Export for: "_$$VAL^XBDIQ1(90213,INDA,.01)_" to "_$$VAL^XBDIQ1(90213,INDA,.02)
  1.  I INA("FILE")=90214 S BDWDESC="Data Warehouse Visit Backload for: "_$$VAL^XBDIQ1(90214,INDA,.01)_" to "_$$VAL^XBDIQ1(90214,INDA,.02)
  1.  I INA("FILE")=90215 S BDWDESC="Full Registration Backload to the Data Warehouse"
  1.  S ZTRTN="HFS1^BDWBHL"
  1.  S ZTIO="",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,$$DELAY(INDA,INA("FILE"))),ZTDESC="DW DATA WAREHOUSE HFS CREATION" S ZTSAVE("BDW*")=""
  1.  D ^%ZTLOAD
  1.  Q
  1. HFS1 ;EP - called from taskman
  1.  N BDWDEST,BDWHDIR,BDWHFNM
  1.  S BDWDEST=$O(^INRHD("B","HL IHS DW1 IE",0))
  1.  Q:'BDWDEST
  1.  K ^INLHDEST(BDWDEST) ;kill off inlhdest
  1.  N BDWQCNT
  1.  S BDWQCNT=$$QCNT(BDWDEST)  ;4/7/05 maw quick count of records to put in ZTS-6
  1.  D SETZTS6(BDWPFL,BDWPIEN,BDWQCNT)
  1.  ;before saving off, reset AUPNDWAF and 4 node in AUPNPAT
  1.  I BDWPFL=90213,'$P($G(^BDWXLOG(BDWPIEN,0)),U,22) D RST4AF^BDWRDR(BDWPIEN)
  1.  I BDWPFL=90213,$P($G(^BDWXLOG(BDWPIEN,0)),U,22) D RESETFLG^BDWBHL1(BDWDEST,BDWPFL,BDWPIEN)
  1.  ;
  1.  D GETDIR
  1.  Q:BDWHDIR=""
  1.  N BDWASU
  1.  S BDWASU=$P($G(^AUTTLOC($P($G(^AUTTSITE(1,0)),U),0)),U,10)
  1.  D NOW^%DTC
  1.  N BDWDTS
  1.  S BDWDTS=$TR(%,".")
  1.  S BDWHFNM=BDWASU_BDWDTS_".BDW"
  1.  D HFSA(BDWDEST,BDWHDIR,BDWHFNM)
  1.  S ZTREQ="@"
  1.  Q
  1.  ;
  1. QCNT(DEST) ;-- let's loop through and get a quick count of records
  1.  N BDWDA,BDWCNT
  1.  S BDWCNT=0
  1.  S BDWDA=0 F  S BDWDA=$O(^BDWTMP(DEST,BDWDA)) Q:'BDWDA  D
  1.  . Q:'$O(^INTHU("AT",BDWDA,0))
  1.  . ;cmi/anch/maw 12/7/2007 filter out A40's?
  1.  . S BDWCNT=BDWCNT+1
  1.  Q +$G(BDWCNT)
  1.  ;
  1. SETZTS6(PFL,PIEN,QCNT) ;-- set ZTS-6 with actual counts
  1.  N TRL
  1.  I PFL=90213 D
  1.  . S TRL=$P($G(^BDWXLOG(PIEN,0)),U,14)
  1.  . Q:'TRL
  1.  . S TRL=$O(^INTHU("AT",TRL,0))
  1.  I PFL=90214 D
  1.  . S TRL=$P($G(^BDWBLOG(PIEN,0)),U,14)
  1.  . Q:'TRL
  1.  . S TRL=$O(^INTHU("AT",TRL,0))
  1.  I PFL=90215 D
  1.  . S TRL=$P($G(^BDWRBLOG(PIEN,0)),U,8)
  1.  . Q:'TRL
  1.  . S TRL=$O(^INTHU("AT",TRL,0))
  1.  Q:'$G(TRL)
  1.  N LDA
  1.  S LDA=0 F  S LDA=$O(^INTHU(TRL,3,LDA)) Q:'LDA  D
  1.  . I $E($G(^INTHU(TRL,3,LDA,0)),1,3)="ZTS" D
  1.  .. S $P(^INTHU(TRL,3,LDA,0),"|",7)=QCNT_"|CR"
  1.  Q