- 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 ;