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

BDWBHL1.m

Go to the documentation of this file. 
  1. BDWBHL1 ; IHS/CMI/LAB - BDW Populate Various DW1 HL7 Segments ;
  1.  ;;1.0;IHS DATA WAREHOUSE;**2,4**;JAN 23, 2006;Build 24
  1.  ;       
  1.  ;
  1. BULL ;EP - called from BDWBHL to send bulletin
  1.  NEW XMSUB,XMDUZ,XMTEXT,XMY,BDWC,BDWBUL
  1.  KILL BDWBUL
  1.  S XMY(BDWUSER)=""
  1.  D WRITEMSG
  1. SUBJECT S XMSUB="* DATA WAREHOUSE PROCESSING COMPLETE *"
  1. SENDER S XMDUZ="Data Warehouse Export System"
  1.  S XMTEXT="BDWBUL("
  1.  D ^XMD
  1.  KILL BDWBUL
  1.  Q
  1.  ;
  1. WRITEMSG ;
  1.  S BDWC=0
  1.  S X="*********** DATA WAREHOUSE EXPORT SYSTEM *************" D SET
  1.  S X="This message is to inform you that the process has completed" D SET
  1.  S X="and the file has been written to the export directory for" D SET
  1.  S X=BDWDESC D SET
  1.  S X=" " D SET
  1.  I $G(BDWSFLG) D
  1.  .S X="The autoftp to the data warehouse FAILED." D SET
  1.  .S X="You will need to manually ftp the file named "_BDWPAFN D SET
  1.  .S X="to the data warehouse." D SET
  1.  Q
  1.  ;;  
  1. SET ;
  1.  S BDWC=BDWC+1
  1.  S BDWBUL(BDWC)=X
  1.  Q
  1. RESETFLG(BDW1DEST,BDW1LOG,BDW1PIEN) ;EP
  1.  ;loop through all messages in ^BDWTMP
  1.  ;if it is a reg message then reset flags in ZRB, ZRL, ZRC, ZRD, ZIN as stored in log
  1.  NEW BDWX,BDWM,BDWZ,BDWY
  1.  S BDWX=0 F  S BDWX=$O(^BDWXLOG(BDWPIEN,41,BDWX))  Q:BDWX'=+BDWX  D
  1.  .S BDWM=$P(^BDWXLOG(BDWPIEN,41,BDWX,0),U,7)
  1.  .Q:BDWM=""
  1.  .S BDWM=$O(^INTHU("AT",BDWM,0))
  1.  .Q:'BDWM
  1.  .Q:'$D(^INTHU(BDWM,0))
  1.  .S BDWY=0 F  S BDWY=$O(^INTHU(BDWM,3,BDWY)) Q:BDWY'=+BDWY  D
  1.  ..I $P(^INTHU(BDWM,3,BDWY,0),"|")="ZRB" S $P(^INTHU(BDWM,3,BDWY,0),"|",4)=$P(^BDWXLOG(BDWPIEN,41,BDWX,0),U,8) I $P(^INTHU(BDWM,3,BDWY,0),"|",2)="" S $P(^INTHU(BDWM,3,BDWY,0),"|",2)=$$DATE^INHUT($P(^BDWXLOG(BDWPIEN,41,BDWX,0),U,2),1)
  1.  ..I $P(^INTHU(BDWM,3,BDWY,0),"|")="ZRL" S $P(^INTHU(BDWM,3,BDWY,0),"|",4)=$P(^BDWXLOG(BDWPIEN,41,BDWX,0),U,9) I $P(^INTHU(BDWM,3,BDWY,0),"|",2)="" S $P(^INTHU(BDWM,3,BDWY,0),"|",2)=$$DATE^INHUT($P(^BDWXLOG(BDWPIEN,41,BDWX,0),U,4),1)
  1.  ..I $P(^INTHU(BDWM,3,BDWY,0),"|")="ZRC" S $P(^INTHU(BDWM,3,BDWY,0),"|",4)=$P(^BDWXLOG(BDWPIEN,41,BDWX,0),U,10) I $P(^INTHU(BDWM,3,BDWY,0),"|",2)="" S $P(^INTHU(BDWM,3,BDWY,0),"|",2)=$$DATE^INHUT($P(^BDWXLOG(BDWPIEN,41,BDWX,0),U,5),1)
  1.  ..I $P(^INTHU(BDWM,3,BDWY,0),"|")="ZRD" S $P(^INTHU(BDWM,3,BDWY,0),"|",4)=$P(^BDWXLOG(BDWPIEN,41,BDWX,0),U,11) I $P(^INTHU(BDWM,3,BDWY,0),"|",2)="" S $P(^INTHU(BDWM,3,BDWY,0),"|",2)=$$DATE^INHUT($P(^BDWXLOG(BDWPIEN,41,BDWX,0),U,3),1)
  1.  ..I $P(^INTHU(BDWM,3,BDWY,0),"|")="ZIN" S $P(^INTHU(BDWM,3,BDWY,0),"|",4)=$P(^BDWXLOG(BDWPIEN,41,BDWX,0),U,12) I $P(^INTHU(BDWM,3,BDWY,0),"|",2)="" S $P(^INTHU(BDWM,3,BDWY,0),"|",2)=$$DATE^INHUT($P(^BDWXLOG(BDWPIEN,41,BDWX,0),U,6),1)
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1.  ;
  1. AUTOSEND ;EP
  1.  S BDWSFLG=$$SENDTO1^ZISHMSMU("DATA WAREHOUSE SEND",BDWPAFN)
  1.  S BDWSFLG(1)=$P(BDWSFLG,"^",2)
  1.  S BDWSFLG=+BDWSFLG
  1.  Q:$D(ZTQUEUED)
  1.  I BDWSFLG'=0 D
  1.  . W:'$D(ZTQUEUED) !,"DW HL7 file was NOT successfully transferred to the data warehouse",!,"you will need to manually ftp it.",!
  1.  . W:'$D(ZTQUEUED) !,BDWSFLG(1),!!
  1.  ;
  1.  Q
  1. SKT ;EP
  1.  K SKT
  1.  ;S BDWCNT=0
  1.  D ST^BDWUTIL1(.SKT,BHLVIEN)
  1.  S BDWDA=0 F  S BDWDA=$O(SKT(BDWDA)) Q:'BDWDA  D
  1.  . S BDWDATA=$G(SKT(BDWDA))
  1.  . S BDWCNT=BDWCNT+1
  1.  . S INDA("SKT",BDWCNT)=""
  1.  . S INA("BDW1SKT1",BDWCNT)=BDWCNT
  1.  . S INA("BDW1SKT2",BDWCNT)="SKT"
  1.  . S INA("BDW1SKT3",BDWCNT)=$P(BDWDATA,U)
  1.  . S INA("BDW1SKT5",BDWCNT)=$P(BDWDATA,U,2)_U_$P(BDWDATA,U,3)
  1.  K BDWDA,BDWDATA,PED
  1.  Q
  1. IFC ;EP p5 ALPMR
  1.  K IFC
  1.  ;S BDWCNT=0
  1.  D IFC^BDWUTIL1(.IFC,BHLVIEN)
  1.  S BDWDA=0 F  S BDWDA=$O(IFC(BDWDA)) Q:'BDWDA  D
  1.  . S BDWDATA=$G(IFC(BDWDA))
  1.  . S BDWCNT=BDWCNT+1
  1.  . S INDA("IFC",BDWCNT)=""
  1.  . S INA("BDW1IFC1",BDWCNT)=BDWCNT
  1.  . S INA("BDW1IFC2",BDWCNT)="IFC"
  1.  . ;S INA("BDW1IFC3",BDWCNT)=$P(BDWDATA,U)
  1.  . S INA("BDW1IFC5",BDWCNT)=$P(BDWDATA,U)_"^"_$P(BDWDATA,U,2)
  1.  K BDWDA,BDWDATA,PED
  1.  Q
  1. PED ;EP
  1.  K PED
  1.  ;S BDWCNT=0
  1.  D PED^BDWUTIL(.PED,BHLVIEN)
  1.  S BDWDA=0 F  S BDWDA=$O(PED(BDWDA)) Q:'BDWDA  D
  1.  . S BDWDATA=$G(PED(BDWDA))
  1.  . S BDWCNT=BDWCNT+1
  1.  . S INDA("PED",BDWCNT)=""
  1.  . S INA("BDW1PED1",BDWCNT)=BDWCNT
  1.  . S INA("BDW1PED2",BDWCNT)="PED"
  1.  . S INA("BDW1PED3",BDWCNT)=$P(BDWDATA,U)
  1.  . S INA("BDW1PED5",BDWCNT)=$P(BDWDATA,U,2)
  1.  . S INA("BDW1PED13",BDWCNT)=$P(BDWDATA,U,3)
  1.  K BDWDA,BDWDATA,PED
  1.  Q
  1.  ;
  1. LAB ;EP
  1.  K LAB
  1.  ;S BDWCNT=0
  1.  D LAB^BDWUTIL(.LAB,BHLVIEN)
  1.  S BDWDA=0 F  S BDWDA=$O(LAB(BDWDA)) Q:'BDWDA  D
  1.  . S BDWDATA=$G(LAB(BDWDA))
  1.  . S BDWCNT=BDWCNT+1
  1.  . S INDA("LAB",BDWCNT)=""
  1.  . S INA("BDW1LAB1",BDWCNT)=BDWCNT
  1.  . S INA("BDW1LAB2",BDWCNT)="LAB"
  1.  . S INA("BDW1LAB3",BDWCNT)=$P(BDWDATA,U)_U_$P(BDWDATA,U,2)
  1.  . S INA("BDW1LAB5",BDWCNT)=$P(BDWDATA,U,3)
  1.  . S INA("BDW1LAB6",BDWCNT)=$P(BDWDATA,U,4)
  1.  . S INA("BDW1LAB7",BDWCNT)=$P(BDWDATA,U,5)_U_$P(BDWDATA,U,6)
  1.  K BDWDA,BDWDATA,LAB
  1.  Q
  1. CPT ;EP
  1.  K CPT,AUPNCPT
  1.  ;S BDWCNT=0
  1.  D CPT^BDWUTIL(.CPT,BHLVIEN)
  1.  S BDWDA=0 F  S BDWDA=$O(CPT(BDWDA)) Q:'BDWDA  D
  1.  . S BDWDATA=$G(CPT(BDWDA))
  1.  . S BDWCNT=BDWCNT+1
  1.  . S INDA("CPT",BDWCNT)=""
  1.  . S INA("BDW1CPT1",BDWCNT)=BDWCNT
  1.  . S INA("BDW1CPT2",BDWCNT)="CPT"
  1.  . S INA("BDW1CPT3",BDWCNT)=$P(BDWDATA,U)
  1.  . S INA("BDW1CPT5",BDWCNT)=$P(BDWDATA,U,2)
  1.  . S INA("BDW1CPT13",BDWCNT)=$TR($P(BDWDATA,U,3),"!","^")
  1.  K BDWDA,BDWDATA,CPT
  1.  Q
  1.  ;
  1. XAM ;EP
  1.  K XAM
  1.  ;S BDWCNT=0
  1.  D EXAM^BDWUTIL(.XAM,BHLVIEN)
  1.  S BDWDA=0 F  S BDWDA=$O(XAM(BDWDA)) Q:'BDWDA  D
  1.  . S BDWDATA=$G(XAM(BDWDA))
  1.  . S BDWCNT=BDWCNT+1
  1.  . S INDA("XAM",BDWCNT)=""
  1.  . S INA("BDW1XAM1",BDWCNT)=BDWCNT
  1.  . S INA("BDW1XAM2",BDWCNT)="XAM"
  1.  . S INA("BDW1XAM3",BDWCNT)=$P(BDWDATA,U)
  1.  K BDWDA,BDWDATA,XAM
  1.  Q
  1.  ;
  1. MSR ;EP
  1.  K MSR
  1.  ;S BDWCNT=0
  1.  D MEAS^BDWUTIL(.MSR,BHLVIEN)
  1.  S BDWDA=0 F  S BDWDA=$O(MSR(BDWDA)) Q:'BDWDA  D
  1.  . S BDWDATA=$G(MSR(BDWDA))
  1.  . S BDWCNT=BDWCNT+1
  1.  . S INDA("MSR",BDWCNT)=""
  1.  . S INA("BDW1MSR1",BDWCNT)=BDWCNT
  1.  . S INA("BDW1MSR2",BDWCNT)="MSR"
  1.  . S INA("BDW1MSR3",BDWCNT)=$P(BDWDATA,U)
  1.  . S INA("BDW1MSR5",BDWCNT)=$P(BDWDATA,U,2)
  1.  K BDWDA,BDWDATA,MSR
  1.  Q
  1. HF ;EP
  1.  K HEF
  1.  S BDWCNT=0
  1.  D MC^BDWUTIL1(.HEF,BHLVIEN)
  1.  S BDWDA=0 F  S BDWDA=$O(HEF(BDWDA)) Q:'BDWDA  D
  1.  . S BDWDATA=$G(HEF(BDWDA))
  1.  . S BDWCNT=BDWCNT+1
  1.  . S INDA("HEF",BDWCNT)=""
  1.  . S INA("BDW1HEF1",BDWCNT)=BDWCNT
  1.  . S INA("BDW1HEF2",BDWCNT)="HF"
  1.  . S INA("BDW1HEF3",BDWCNT)=$P(BDWDATA,U,3)_U_$P(BDWDATA,U,2)
  1.  . S INA("BDW1HEF4",BDWCNT)=$P(BDWDATA,U,5)_U_$P(BDWDATA,U,4)
  1.  K BDWDA,BDWDATA,HEF
  1.  Q
  1.  ;
  1. ZIM ;EP - populate the dw1 ZIM segment
  1.  K IMM
  1.  S BDWCNT=0
  1.  D IMM^BDWUTIL1(.IMM,BHLVIEN)
  1.  S BDWDA=0 F  S BDWDA=$O(IMM(BDWDA)) Q:'BDWDA  D
  1.  . S BDWDATA=$G(IMM(BDWDA))
  1.  . S BDWCNT=BDWCNT+1
  1.  . S INDA("ZIM",BDWCNT)=""
  1.  . S INA("BDW1ZIM1",BDWCNT)=BDWCNT
  1.  . S INA("BDW1ZIM2",BDWCNT)=$P(BDWDATA,U,3)  ;cmi/anch/maw 3/25/2008 for CVX codeset
  1.  . S INA("BDW1ZIM3",BDWCNT)=$P(BDWDATA,U,2)
  1.  . ;S INA("BDW1ZIM4",BDWCNT)=$P(BDWDATA,U,3)  ;cmi/anch/maw 4/16/2008 no longer wanted per Lisa Hunt email
  1.  . S INA("BDW1ZIM5",BDWCNT)=$P(BDWDATA,U,4)
  1.  . S INA("BDW1ZIM6",BDWCNT)=$P(BDWDATA,U,5)
  1.  K BDWCNT,BDWDA,BDWDATA,IMM
  1.  Q
  1.  ;
  1. DW1ALPMR(BHLPAT) ;-- generate an A08 for dw1 alpmr patient centric
  1.  I 'BHLPAT Q $$MSG^BHLEVENT("PAT")
  1.  S INDA=BHLPAT
  1.  I $G(INA) S INA("BACKLOAD")=1
  1.  D ^INHF("HL IHS DW1ALPMR A08 OUT PARENT",.INDA,.INA)
  1.  D EOJ^BHLEVENT
  1.  Q $P($$MSG^BHLEVENT(INHF),U)
  1.  ;