- BDWUTIL2 ; IHS/CMI/LAB - Data Warehouse Utilities ;
- ;;1.0;IHS DATA WAREHOUSE;**4**;JAN 23, 2006;Build 24
- ;
- ;
- ;
- PRB(RETVAL,BDWP) ;EP
- N PRB,DX,DXS,DXI,DXD,DXT,DTA,DLM,PN,FAC,POVN,SC,ST,DTDL,DTO,CNT
- K RETVAL
- I '$D(^AUPNPROB("AC",BDWP)) Q
- S CNT=0
- N PDA,DATA
- S PDA=0 F S PDA=$O(^AUPNPROB("AC",BDWP,PDA)) Q:'PDA D
- . S CNT=CNT+1
- . S DATA=$G(^AUPNPROB(PDA,0))
- . S DXI=$P(DATA,U)
- . I $D(^ICDS(0)) S DXS=$$ICDDX^ICDEX(DXI)
- . I '$D(^ICDS(0)) S DXS=$$ICDDX^ICDCODE(DXI)
- . S DX=$TR($P(DXS,U,2),"|","")
- . S DXD=$TR($P(DXS,U,4),"|","")
- . S DXT=$P(DXS,U,20)
- . S DXT=$S(DXT=30:"I10",1:"I9")
- . S DTA=$$FMTHL7^XLFDT($E($P(DATA,U,8),1,7))
- . S DLM=$$FMTHL7^XLFDT($E($P(DATA,U,3),1,7))
- . S PN=$P(DATA,U,7)
- . S FAC=$$GET1^DIQ(9999999.06,$P(DATA,U,6),.12)
- . S POVN=$$GET1^DIQ(9000011,PDA,.05)
- . S POVN=$TR(POVN,"|","")
- . S SC=$P(DATA,U,12)
- . S ST=$$GET1^DIQ(9000011,PDA,.12)
- . S DTDL=$$FMTHL7^XLFDT($E($P($G(^AUPNPROB(PDA,2)),U,2),1,7))
- . S DTO=$$FMTHL7^XLFDT($E($P(DATA,U,13),1,7))
- . S RETVAL(CNT)=DX_U_DXD_U_DXT_U_DTA_U_DLM_U_PN_U_FAC_U_POVN_U_SC_U_ST_U_DTDL_U_DTO
- Q
- ;
- REF(RETVAL,BDWP) ;EP
- N REF,RFT,RFI,DTR,RFRC,RFRT,DLM,FL
- K RETVAL
- I '$D(^AUPNPREF("AC",BDWP)) Q
- S CNT=0
- N PDA,DATA
- S PDA=0 F S PDA=$O(^AUPNPREF("AC",BDWP,PDA)) Q:'PDA D
- . S CNT=CNT+1
- . S DATA=$G(^AUPNPREF(PDA,0))
- . S RFT=$$GET1^DIQ(9000022,PDA,.01)
- . S FL=$P(DATA,U,5)
- . S RFI=$P(DATA,U,6)
- . S RFI=$$GET1^DIQ(FL,RFI,.01)
- . S DTR=$$FMTHL7^XLFDT($P(DATA,U,3))
- . S RFRC=$P(DATA,U,7)
- . S RFRT=$$GET1^DIQ(9000022,PDA,.07)
- . S DLM=$$FMTHL7^XLFDT($E($P(DATA,U,8),1,7))
- . S RETVAL(CNT)=RFT_U_RFI_U_DTR_U_RFRC_U_RFRT_U_DLM
- Q
- ;
- IMC(RETVAL,BDWP) ;EP
- N VAC,RC,DTN,VACI
- K RETVAL
- I '$D(^BIPC("B",BDWP)) Q
- S CNT=0
- N PDA,DATA
- S PDA=0 F S PDA=$O(^BIPC("B",BDWP,PDA)) Q:'PDA D
- . S CNT=CNT+1
- . S VACI=$$GET1^DIQ(9002084.11,PDA,.02,"I")
- . S VAC=$$GET1^DIQ(9999999.14,VACI,.03)
- . S RC=$$GET1^DIQ(9002084.11,PDA,.03)
- . S DTN=$$FMTHL7^XLFDT($$GET1^DIQ(9002084.11,PDA,.04,"I"))
- . S RETVAL(CNT)=VAC_U_RC_U_DTN
- Q
- ;
- WH(RETVAL,BDWP) ;EP
- N WHP,RS,PDT
- K RETVAL
- I '$D(^BWPCD("C",BDWP)) Q
- S CNT=0
- N PDA,DATA
- S PDA=0 F S PDA=$O(^BWPCD("C",BDWP,PDA)) Q:'PDA D
- . S CNT=CNT+1
- . S WHP=$$GET1^DIQ(9002086.1,PDA,.04)
- . S RS=$$GET1^DIQ(9002086.1,PDA,.05)
- . S PDT=$$FMTHL7^XLFDT($$GET1^DIQ(9002086.1,PDA,.12,"I"))
- . S RETVAL(CNT)=WHP_U_RS_U_PDT
- Q
- ;
- BDWUTIL2 ; IHS/CMI/LAB - Data Warehouse Utilities ;
- +1 ;;1.0;IHS DATA WAREHOUSE;**4**;JAN 23, 2006;Build 24
- +2 ;
- +3 ;
- +4 ;
- PRB(RETVAL,BDWP) ;EP
- +1 NEW PRB,DX,DXS,DXI,DXD,DXT,DTA,DLM,PN,FAC,POVN,SC,ST,DTDL,DTO,CNT
- +2 KILL RETVAL
- +3 IF '$DATA(^AUPNPROB("AC",BDWP))
- QUIT
- +4 SET CNT=0
- +5 NEW PDA,DATA
- +6 SET PDA=0
- FOR
- SET PDA=$ORDER(^AUPNPROB("AC",BDWP,PDA))
- IF 'PDA
- QUIT
- Begin DoDot:1
- +7 SET CNT=CNT+1
- +8 SET DATA=$GET(^AUPNPROB(PDA,0))
- +9 SET DXI=$PIECE(DATA,U)
- +10 IF $DATA(^ICDS(0))
- SET DXS=$$ICDDX^ICDEX(DXI)
- +11 IF '$DATA(^ICDS(0))
- SET DXS=$$ICDDX^ICDCODE(DXI)
- +12 SET DX=$TRANSLATE($PIECE(DXS,U,2),"|","")
- +13 SET DXD=$TRANSLATE($PIECE(DXS,U,4),"|","")
- +14 SET DXT=$PIECE(DXS,U,20)
- +15 SET DXT=$SELECT(DXT=30:"I10",1:"I9")
- +16 SET DTA=$$FMTHL7^XLFDT($EXTRACT($PIECE(DATA,U,8),1,7))
- +17 SET DLM=$$FMTHL7^XLFDT($EXTRACT($PIECE(DATA,U,3),1,7))
- +18 SET PN=$PIECE(DATA,U,7)
- +19 SET FAC=$$GET1^DIQ(9999999.06,$PIECE(DATA,U,6),.12)
- +20 SET POVN=$$GET1^DIQ(9000011,PDA,.05)
- +21 SET POVN=$TRANSLATE(POVN,"|","")
- +22 SET SC=$PIECE(DATA,U,12)
- +23 SET ST=$$GET1^DIQ(9000011,PDA,.12)
- +24 SET DTDL=$$FMTHL7^XLFDT($EXTRACT($PIECE($GET(^AUPNPROB(PDA,2)),U,2),1,7))
- +25 SET DTO=$$FMTHL7^XLFDT($EXTRACT($PIECE(DATA,U,13),1,7))
- +26 SET RETVAL(CNT)=DX_U_DXD_U_DXT_U_DTA_U_DLM_U_PN_U_FAC_U_POVN_U_SC_U_ST_U_DTDL_U_DTO
- End DoDot:1
- +27 QUIT
- +28 ;
- REF(RETVAL,BDWP) ;EP
- +1 NEW REF,RFT,RFI,DTR,RFRC,RFRT,DLM,FL
- +2 KILL RETVAL
- +3 IF '$DATA(^AUPNPREF("AC",BDWP))
- QUIT
- +4 SET CNT=0
- +5 NEW PDA,DATA
- +6 SET PDA=0
- FOR
- SET PDA=$ORDER(^AUPNPREF("AC",BDWP,PDA))
- IF 'PDA
- QUIT
- Begin DoDot:1
- +7 SET CNT=CNT+1
- +8 SET DATA=$GET(^AUPNPREF(PDA,0))
- +9 SET RFT=$$GET1^DIQ(9000022,PDA,.01)
- +10 SET FL=$PIECE(DATA,U,5)
- +11 SET RFI=$PIECE(DATA,U,6)
- +12 SET RFI=$$GET1^DIQ(FL,RFI,.01)
- +13 SET DTR=$$FMTHL7^XLFDT($PIECE(DATA,U,3))
- +14 SET RFRC=$PIECE(DATA,U,7)
- +15 SET RFRT=$$GET1^DIQ(9000022,PDA,.07)
- +16 SET DLM=$$FMTHL7^XLFDT($EXTRACT($PIECE(DATA,U,8),1,7))
- +17 SET RETVAL(CNT)=RFT_U_RFI_U_DTR_U_RFRC_U_RFRT_U_DLM
- End DoDot:1
- +18 QUIT
- +19 ;
- IMC(RETVAL,BDWP) ;EP
- +1 NEW VAC,RC,DTN,VACI
- +2 KILL RETVAL
- +3 IF '$DATA(^BIPC("B",BDWP))
- QUIT
- +4 SET CNT=0
- +5 NEW PDA,DATA
- +6 SET PDA=0
- FOR
- SET PDA=$ORDER(^BIPC("B",BDWP,PDA))
- IF 'PDA
- QUIT
- Begin DoDot:1
- +7 SET CNT=CNT+1
- +8 SET VACI=$$GET1^DIQ(9002084.11,PDA,.02,"I")
- +9 SET VAC=$$GET1^DIQ(9999999.14,VACI,.03)
- +10 SET RC=$$GET1^DIQ(9002084.11,PDA,.03)
- +11 SET DTN=$$FMTHL7^XLFDT($$GET1^DIQ(9002084.11,PDA,.04,"I"))
- +12 SET RETVAL(CNT)=VAC_U_RC_U_DTN
- End DoDot:1
- +13 QUIT
- +14 ;
- WH(RETVAL,BDWP) ;EP
- +1 NEW WHP,RS,PDT
- +2 KILL RETVAL
- +3 IF '$DATA(^BWPCD("C",BDWP))
- QUIT
- +4 SET CNT=0
- +5 NEW PDA,DATA
- +6 SET PDA=0
- FOR
- SET PDA=$ORDER(^BWPCD("C",BDWP,PDA))
- IF 'PDA
- QUIT
- Begin DoDot:1
- +7 SET CNT=CNT+1
- +8 SET WHP=$$GET1^DIQ(9002086.1,PDA,.04)
- +9 SET RS=$$GET1^DIQ(9002086.1,PDA,.05)
- +10 SET PDT=$$FMTHL7^XLFDT($$GET1^DIQ(9002086.1,PDA,.12,"I"))
- +11 SET RETVAL(CNT)=WHP_U_RS_U_PDT
- End DoDot:1
- +12 QUIT
- +13 ;
