BDWALPMR ; IHS/CMI/LAB - BDW Populate Various DW1 HL7 Segments ; [ 04/05/2007 2:56 PM ]
;;1.0;IHS DATA WAREHOUSE;**4**;JAN 23, 2006;Build 24
;
;this routine will set up all of the necessary variables to populate varios DW1 HL7 segments
;
MAIN ;EP - this is the main routine driver
S INQUE=1 ;cmi/anch/maw 7/26/04 this appears to suppress output queue setup in GIS for this interfaces A08 message
;I '$G(BHLVIEN) S BHLVIEN=INDA
S DFN=INDA
S BDWREGID=$$UID^BDWAID(DFN)
D ZPB,ZRF,ZMC,WH
K BDWREGID
Q
;
ZPB ;EP - populate the dw1 ZPB segment
K PRB
S BDWCNT=0
D PRB^BDWUTIL2(.PRB,INDA)
S BDWDA=0 F S BDWDA=$O(PRB(BDWDA)) Q:'BDWDA D
. S BDWDATA=$G(PRB(BDWDA))
. S BDWCNT=BDWCNT+1
. S INDA("ZPB",BDWCNT)=""
. S INA("BDW1ZPB1",BDWCNT)=BDWCNT
. S INA("BDW1ZPB2",BDWCNT)=$P(BDWDATA,U)_U_$P(BDWDATA,U,2)_U_$P(BDWDATA,U,3)
. S INA("BDW1ZPB3",BDWCNT)=$P(BDWDATA,U,4)
. S INA("BDW1ZPB4",BDWCNT)=$P(BDWDATA,U,5)
. S INA("BDW1ZPB5",BDWCNT)=$P(BDWDATA,U,6)
. S INA("BDW1ZPB6",BDWCNT)=$P(BDWDATA,U,7)
. S INA("BDW1ZPB7",BDWCNT)=$P(BDWDATA,U,8)
. S INA("BDW1ZPB8",BDWCNT)=$P(BDWDATA,U,9)_U_$P(BDWDATA,U,10)
. S INA("BDW1ZPB9",BDWCNT)=$P(BDWDATA,U,11)
. S INA("BDW1ZPB10",BDWCNT)=$P(BDWDATA,U,12)
. S INA("BDW1ZPB11",BDWCNT)=BDWREGID
K BDWDA,BDWCNT,BDWDATA,PRB
Q
;
ZRF ;EP - populate the dw1 ZRF segment
K REF
S BDWCNT=0
D REF^BDWUTIL2(.REF,INDA)
S BDWDA=0 F S BDWDA=$O(REF(BDWDA)) Q:'BDWDA D
. S BDWDATA=$G(REF(BDWDA))
. S BDWCNT=BDWCNT+1
. S INDA("ZRF",BDWCNT)=""
. S INA("BDW1ZRF1",BDWCNT)=BDWCNT
. S INA("BDW1ZRF2",BDWCNT)=$P(BDWDATA,U)
. S INA("BDW1ZRF3",BDWCNT)=$P(BDWDATA,U,2)
. S INA("BDW1ZRF4",BDWCNT)=$P(BDWDATA,U,3)
. S INA("BDW1ZRF5",BDWCNT)=$P(BDWDATA,U,4)_U_$P(BDWDATA,U,5)
. S INA("BDW1ZRF6",BDWCNT)=$P(BDWDATA,U,6)
. S INA("BDW1ZRF7",BDWCNT)=BDWREGID
K BDWCNT,BDWDA,BDWDATA,REF
Q
;
ZMC ;EP - populate the dw1 ZMC
K IMC
S BDWCNT=0
D IMC^BDWUTIL2(.IMC,INDA)
S BDWDA=0 F S BDWDA=$O(IMC(BDWDA)) Q:'BDWDA D
. S BDWDATA=$G(IMC(BDWDA))
. S BDWCNT=BDWCNT+1
. S INDA("ZMC",BDWCNT)=""
. S INA("BDW1ZMC1",BDWCNT)=BDWCNT
. S INA("BDW1ZMC2",BDWCNT)=$P(BDWDATA,U)
. S INA("BDW1ZMC3",BDWCNT)=$P(BDWDATA,U,2)
. S INA("BDW1ZMC4",BDWCNT)=$P(BDWDATA,U,3)
. S INA("BDW1ZMC5",BDWCNT)=BDWREGID
K BDWCNT,BDWDA,BDWDATA,IMC
Q
;
WH ;EP
K WH
S BDWCNT=0
D WH^BDWUTIL2(.WH,INDA)
S BDWDA=0 F S BDWDA=$O(WH(BDWDA)) Q:'BDWDA D
. S BDWDATA=$G(WH(BDWDA))
. S BDWCNT=BDWCNT+1
. S INDA("WHP",BDWCNT)=""
. S INA("BDW1WH1",BDWCNT)=BDWCNT
. S INA("BDW1WH2",BDWCNT)="WH"
. S INA("BDW1WH3",BDWCNT)=$P(BDWDATA,U)
. S INA("BDW1WH5",BDWCNT)=$P(BDWDATA,U,2)
. S INA("BDW1WH14",BDWCNT)=$P(BDWDATA,U,3)
. S INA("BDW1WH15",BDWCNT)=BDWREGID
K BDWDA,BDWDATA,WH
Q
;
BDWALPMR ; IHS/CMI/LAB - BDW Populate Various DW1 HL7 Segments ; [ 04/05/2007 2:56 PM ]
+1 ;;1.0;IHS DATA WAREHOUSE;**4**;JAN 23, 2006;Build 24
+2 ;
+3 ;this routine will set up all of the necessary variables to populate varios DW1 HL7 segments
+4 ;
MAIN ;EP - this is the main routine driver
+1 ;cmi/anch/maw 7/26/04 this appears to suppress output queue setup in GIS for this interfaces A08 message
SET INQUE=1
+2 ;I '$G(BHLVIEN) S BHLVIEN=INDA
+3 SET DFN=INDA
+4 SET BDWREGID=$$UID^BDWAID(DFN)
+5 DO ZPB
DO ZRF
DO ZMC
DO WH
+6 KILL BDWREGID
+7 QUIT
+8 ;
ZPB ;EP - populate the dw1 ZPB segment
+1 KILL PRB
+2 SET BDWCNT=0
+3 DO PRB^BDWUTIL2(.PRB,INDA)
+4 SET BDWDA=0
FOR
SET BDWDA=$ORDER(PRB(BDWDA))
IF 'BDWDA
QUIT
Begin DoDot:1
+5 SET BDWDATA=$GET(PRB(BDWDA))
+6 SET BDWCNT=BDWCNT+1
+7 SET INDA("ZPB",BDWCNT)=""
+8 SET INA("BDW1ZPB1",BDWCNT)=BDWCNT
+9 SET INA("BDW1ZPB2",BDWCNT)=$PIECE(BDWDATA,U)_U_$PIECE(BDWDATA,U,2)_U_$PIECE(BDWDATA,U,3)
+10 SET INA("BDW1ZPB3",BDWCNT)=$PIECE(BDWDATA,U,4)
+11 SET INA("BDW1ZPB4",BDWCNT)=$PIECE(BDWDATA,U,5)
+12 SET INA("BDW1ZPB5",BDWCNT)=$PIECE(BDWDATA,U,6)
+13 SET INA("BDW1ZPB6",BDWCNT)=$PIECE(BDWDATA,U,7)
+14 SET INA("BDW1ZPB7",BDWCNT)=$PIECE(BDWDATA,U,8)
+15 SET INA("BDW1ZPB8",BDWCNT)=$PIECE(BDWDATA,U,9)_U_$PIECE(BDWDATA,U,10)
+16 SET INA("BDW1ZPB9",BDWCNT)=$PIECE(BDWDATA,U,11)
+17 SET INA("BDW1ZPB10",BDWCNT)=$PIECE(BDWDATA,U,12)
+18 SET INA("BDW1ZPB11",BDWCNT)=BDWREGID
End DoDot:1
+19 KILL BDWDA,BDWCNT,BDWDATA,PRB
+20 QUIT
+21 ;
ZRF ;EP - populate the dw1 ZRF segment
+1 KILL REF
+2 SET BDWCNT=0
+3 DO REF^BDWUTIL2(.REF,INDA)
+4 SET BDWDA=0
FOR
SET BDWDA=$ORDER(REF(BDWDA))
IF 'BDWDA
QUIT
Begin DoDot:1
+5 SET BDWDATA=$GET(REF(BDWDA))
+6 SET BDWCNT=BDWCNT+1
+7 SET INDA("ZRF",BDWCNT)=""
+8 SET INA("BDW1ZRF1",BDWCNT)=BDWCNT
+9 SET INA("BDW1ZRF2",BDWCNT)=$PIECE(BDWDATA,U)
+10 SET INA("BDW1ZRF3",BDWCNT)=$PIECE(BDWDATA,U,2)
+11 SET INA("BDW1ZRF4",BDWCNT)=$PIECE(BDWDATA,U,3)
+12 SET INA("BDW1ZRF5",BDWCNT)=$PIECE(BDWDATA,U,4)_U_$PIECE(BDWDATA,U,5)
+13 SET INA("BDW1ZRF6",BDWCNT)=$PIECE(BDWDATA,U,6)
+14 SET INA("BDW1ZRF7",BDWCNT)=BDWREGID
End DoDot:1
+15 KILL BDWCNT,BDWDA,BDWDATA,REF
+16 QUIT
+17 ;
ZMC ;EP - populate the dw1 ZMC
+1 KILL IMC
+2 SET BDWCNT=0
+3 DO IMC^BDWUTIL2(.IMC,INDA)
+4 SET BDWDA=0
FOR
SET BDWDA=$ORDER(IMC(BDWDA))
IF 'BDWDA
QUIT
Begin DoDot:1
+5 SET BDWDATA=$GET(IMC(BDWDA))
+6 SET BDWCNT=BDWCNT+1
+7 SET INDA("ZMC",BDWCNT)=""
+8 SET INA("BDW1ZMC1",BDWCNT)=BDWCNT
+9 SET INA("BDW1ZMC2",BDWCNT)=$PIECE(BDWDATA,U)
+10 SET INA("BDW1ZMC3",BDWCNT)=$PIECE(BDWDATA,U,2)
+11 SET INA("BDW1ZMC4",BDWCNT)=$PIECE(BDWDATA,U,3)
+12 SET INA("BDW1ZMC5",BDWCNT)=BDWREGID
End DoDot:1
+13 KILL BDWCNT,BDWDA,BDWDATA,IMC
+14 QUIT
+15 ;
WH ;EP
+1 KILL WH
+2 SET BDWCNT=0
+3 DO WH^BDWUTIL2(.WH,INDA)
+4 SET BDWDA=0
FOR
SET BDWDA=$ORDER(WH(BDWDA))
IF 'BDWDA
QUIT
Begin DoDot:1
+5 SET BDWDATA=$GET(WH(BDWDA))
+6 SET BDWCNT=BDWCNT+1
+7 SET INDA("WHP",BDWCNT)=""
+8 SET INA("BDW1WH1",BDWCNT)=BDWCNT
+9 SET INA("BDW1WH2",BDWCNT)="WH"
+10 SET INA("BDW1WH3",BDWCNT)=$PIECE(BDWDATA,U)
+11 SET INA("BDW1WH5",BDWCNT)=$PIECE(BDWDATA,U,2)
+12 SET INA("BDW1WH14",BDWCNT)=$PIECE(BDWDATA,U,3)
+13 SET INA("BDW1WH15",BDWCNT)=BDWREGID
End DoDot:1
+14 KILL BDWDA,BDWDATA,WH
+15 QUIT
+16 ;
