- BDW1VBL2 ;IHS/CMI/LAB - DW process visit during backload;
- ;;1.0;IHS DATA WAREHOUSE;;JAN 23, 2006
- ;
- ;
- K BDWE
- D VISIT
- I $D(BDWE) D ^BDW1VBLE Q
- D PROCTX
- K BDWE,BDWT,BDWH
- Q
- ;
- VISIT ;EP
- I '$P(BDWV("V REC"),U,9),'$P(BDWV("V REC"),U,11) S BDW("ZERO")=BDW("ZERO")+1,BDWE("ERROR")=102 Q
- S BDWV("TYPE")=$P(BDWV("V REC"),U,3)
- I BDWV("TYPE")="" S BDWE("ERROR")="130",BDW("NO TYPE")=BDW("NO TYPE")+1 Q
- S BDWV("SRV CAT")=$P(BDWV("V REC"),U,7)
- I BDWV("SRV CAT")="" S BDWE("ERROR")="132",BDW("NO CAT")=BDW("NO CAT")+1 Q
- S BDWV("LOC DFN")=$P(BDWV("V REC"),U,6)
- ;I BDWV("LOC DFN")="" S BDWE("ERROR")="111",BDW("NO LOC")=BDW("NO LOC")+1 Q ;cmi/anch/maw 7/26/2004 changed due to location at Crow being 0
- I '+$G(BDWV("LOC DFN")) S BDWE("ERROR")="111",BDW("NO LOC")=BDW("NO LOC")+1 Q ;cmi/anch/maw 7/26/2004 modified
- I '$D(^AUTTLOC(BDWV("LOC DFN"),0)) S BDWE("ERROR")="111",BDW("NO LOC")=BDW("NO LOC")+1 Q ;cmi/anch/maw 7/26/2004 modified
- S BDWV("IHS LOCATION CODE")=$P(^AUTTLOC(BDWV("LOC DFN"),0),U,10) I BDWV("IHS LOCATION CODE")="" S BDWE("ERROR")="113",BDW("NO LOC")=BDW("NO LOC")+1 Q
- S BDWV("PATIENT DFN")=$P(BDWV("V REC"),U,5) I BDWV("PATIENT DFN")="" S BDWE("ERROR")="104",BDW("NO PAT")=BDW("NO PAT")+1 Q
- I '$D(^DPT(BDWV("PATIENT DFN"),0)) S BDWE("ERROR")="104",BDW("NO PAT")=BDW("NO PAT")+1 Q
- S Y=BDWV("PATIENT DFN") D ^AUPNPAT
- S BDWV("PATIENT NAME")=$P(^DPT(BDWV("PATIENT DFN"),0),U)
- I BDWV("PATIENT NAME")["DEMO,PATIENT" S BDW("DEMO")=BDW("DEMO")+1,BDWE("ERROR")=101 Q
- Q
- ;
- PROCTX ; process and generate appropriate statistical record
- S BDW("VISITS")=$G(BDW("VISITS"))+1
- S BDWVMSG=$$DW1A08^BHLEVENT(BDW("V DFN"))
- S ^BDWTMP(BDWIEDST,BDWVMSG)=""
- ;I BDWVA D VA
- D VA
- D RESET^BDW1VBL
- Q
- VREC(BDWVIEN,BDWRTYP,DFN,BDWVFIEN) ;EP
- S BDWRIEN=$O(^BDWVARD("B",BDWRTYP,0))
- I 'BDWRIEN Q ""
- NEW BDWY,BDWT S BDWY=0,BDWT="" F S BDWY=$O(^BDWVARD(BDWRIEN,11,"B",BDWY)) Q:BDWY'=+BDWY D
- .S X=""
- .S BDWZ=$O(^BDWVARD(BDWRIEN,11,"B",BDWY,0))
- .Q:'$D(^BDWVARD(BDWRIEN,11,BDWZ,1))
- .X ^BDWVARD(BDWRIEN,11,BDWZ,1)
- .S $P(BDWT,U,BDWY)=X
- Q BDWT
- VA ;EP
- S BDWVIEN=BDW("V DFN")
- S BDWPDFN=$P($G(^AUPNVSIT(BDWVIEN,0)),U,5)
- I BDWPDFN="" Q ""
- S BDWUVID=$$UIDV^BDWAID(BDWVIEN)
- S BDWVAX=$$VREC(BDWVIEN,"V000",BDWPDFN,0)
- D SET
- K BDWVAY D PROV^BDWUTIL1(.BDWVAY,BDWVIEN)
- I $G(BDWVAY(1))="" D
- . S BDWVAX="V010"_U_BDWUVID_U_"1^^^" D SET
- S BDWVAY=0 F S BDWVAY=$O(BDWVAY(BDWVAY)) Q:BDWVAY'=+BDWVAY D
- .S BDWVAX="V010"_U_BDWUVID_U_BDWVAY_U_$E($P(BDWVAY(BDWVAY),U,3))_U_$E($P(BDWVAY(BDWVAY),U,3),2,3)_U_$P(BDWVAY(BDWVAY),U,8)
- .D SET
- .Q
- K BDWVAY D CPT^BDWUTIL(.BDWVAY,BDWVIEN)
- S BDWVAY=0 F S BDWVAY=$O(BDWVAY(BDWVAY)) Q:BDWVAY'=+BDWVAY D
- .S BDWVAX="V025"_U_BDWUVID_U_BDWVAY_U_$P(BDWVAY(BDWVAY),U)_U_$P(BDWVAY(BDWVAY),U,2)
- .D SET
- .Q
- K BDWVAY D PROC^BDWUTIL1(.BDWVAY,BDWVIEN)
- S BDWVAY=0 F S BDWVAY=$O(BDWVAY(BDWVAY)) Q:BDWVAY'=+BDWVAY D
- .S BDWVAX="V020"_U_BDWUVID_U_BDWVAY_U_$P(BDWVAY(BDWVAY),U)_U_$$DATE^INHUT($P(BDWVAY(BDWVAY),U,2))_U_$P(BDWVAY(BDWVAY),U,6)
- .D SET
- .Q
- K BDWVAY D DENT^BDWUTIL(.BDWVAY,BDWVIEN)
- S BDWVAY=0 F S BDWVAY=$O(BDWVAY(BDWVAY)) Q:BDWVAY'=+BDWVAY D
- .S BDWVAX="V030"_U_BDWUVID_U_BDWVAY_U_$P(BDWVAY(BDWVAY),U)_U_$P(BDWVAY(BDWVAY),U,2)_U_$P(BDWVAY(BDWVAY),U,3)
- .D SET
- .Q
- K BDWVAY D POVS^BDWUTIL(.BDWVAY,BDWVIEN)
- S BDWVAY=0 F S BDWVAY=$O(BDWVAY(BDWVAY)) Q:BDWVAY'=+BDWVAY D
- .S BDWVAX="V040"_U_BDWUVID_U_BDWVAY_U_$P(BDWVAY(BDWVAY),U)_U_$P(BDWVAY(BDWVAY),U,2)_U_$P(BDWVAY(BDWVAY),U,3)_U_$P(BDWVAY(BDWVAY),U,4)
- .D SET
- .Q
- Q
- ;
- SET ;
- S BDWVA("COUNT")=BDWVA("COUNT")+1
- I BDWVA("COUNT")=1 S ^BDWDATA(BDWVA("COUNT"))="H0^"_$P($$DATE^INHUT($$NOW^XLFDT,1),"-",1),BDWVA("COUNT")=BDWVA("COUNT")+1
- S ^BDWDATA(BDWVA("COUNT"))=BDWVAX
- Q
- BDW1VBL2 ;IHS/CMI/LAB - DW process visit during backload;
- +1 ;;1.0;IHS DATA WAREHOUSE;;JAN 23, 2006
- +2 ;
- +3 ;
- +4 KILL BDWE
- +5 DO VISIT
- +6 IF $DATA(BDWE)
- DO ^BDW1VBLE
- QUIT
- +7 DO PROCTX
- +8 KILL BDWE,BDWT,BDWH
- +9 QUIT
- +10 ;
- VISIT ;EP
- +1 IF '$PIECE(BDWV("V REC"),U,9)
- IF '$PIECE(BDWV("V REC"),U,11)
- SET BDW("ZERO")=BDW("ZERO")+1
- SET BDWE("ERROR")=102
- QUIT
- +2 SET BDWV("TYPE")=$PIECE(BDWV("V REC"),U,3)
- +3 IF BDWV("TYPE")=""
- SET BDWE("ERROR")="130"
- SET BDW("NO TYPE")=BDW("NO TYPE")+1
- QUIT
- +4 SET BDWV("SRV CAT")=$PIECE(BDWV("V REC"),U,7)
- +5 IF BDWV("SRV CAT")=""
- SET BDWE("ERROR")="132"
- SET BDW("NO CAT")=BDW("NO CAT")+1
- QUIT
- +6 SET BDWV("LOC DFN")=$PIECE(BDWV("V REC"),U,6)
- +7 ;I BDWV("LOC DFN")="" S BDWE("ERROR")="111",BDW("NO LOC")=BDW("NO LOC")+1 Q ;cmi/anch/maw 7/26/2004 changed due to location at Crow being 0
- +8 ;cmi/anch/maw 7/26/2004 modified
- IF '+$GET(BDWV("LOC DFN"))
- SET BDWE("ERROR")="111"
- SET BDW("NO LOC")=BDW("NO LOC")+1
- QUIT
- +9 ;cmi/anch/maw 7/26/2004 modified
- IF '$DATA(^AUTTLOC(BDWV("LOC DFN"),0))
- SET BDWE("ERROR")="111"
- SET BDW("NO LOC")=BDW("NO LOC")+1
- QUIT
- +10 SET BDWV("IHS LOCATION CODE")=$PIECE(^AUTTLOC(BDWV("LOC DFN"),0),U,10)
- IF BDWV("IHS LOCATION CODE")=""
- SET BDWE("ERROR")="113"
- SET BDW("NO LOC")=BDW("NO LOC")+1
- QUIT
- +11 SET BDWV("PATIENT DFN")=$PIECE(BDWV("V REC"),U,5)
- IF BDWV("PATIENT DFN")=""
- SET BDWE("ERROR")="104"
- SET BDW("NO PAT")=BDW("NO PAT")+1
- QUIT
- +12 IF '$DATA(^DPT(BDWV("PATIENT DFN"),0))
- SET BDWE("ERROR")="104"
- SET BDW("NO PAT")=BDW("NO PAT")+1
- QUIT
- +13 SET Y=BDWV("PATIENT DFN")
- DO ^AUPNPAT
- +14 SET BDWV("PATIENT NAME")=$PIECE(^DPT(BDWV("PATIENT DFN"),0),U)
- +15 IF BDWV("PATIENT NAME")["DEMO,PATIENT"
- SET BDW("DEMO")=BDW("DEMO")+1
- SET BDWE("ERROR")=101
- QUIT
- +16 QUIT
- +17 ;
- PROCTX ; process and generate appropriate statistical record
- +1 SET BDW("VISITS")=$GET(BDW("VISITS"))+1
- +2 SET BDWVMSG=$$DW1A08^BHLEVENT(BDW("V DFN"))
- +3 SET ^BDWTMP(BDWIEDST,BDWVMSG)=""
- +4 ;I BDWVA D VA
- +5 DO VA
- +6 DO RESET^BDW1VBL
- +7 QUIT
- VREC(BDWVIEN,BDWRTYP,DFN,BDWVFIEN) ;EP
- +1 SET BDWRIEN=$ORDER(^BDWVARD("B",BDWRTYP,0))
- +2 IF 'BDWRIEN
- QUIT ""
- +3 NEW BDWY,BDWT
- SET BDWY=0
- SET BDWT=""
- FOR
- SET BDWY=$ORDER(^BDWVARD(BDWRIEN,11,"B",BDWY))
- IF BDWY'=+BDWY
- QUIT
- Begin DoDot:1
- +4 SET X=""
- +5 SET BDWZ=$ORDER(^BDWVARD(BDWRIEN,11,"B",BDWY,0))
- +6 IF '$DATA(^BDWVARD(BDWRIEN,11,BDWZ,1))
- QUIT
- +7 XECUTE ^BDWVARD(BDWRIEN,11,BDWZ,1)
- +8 SET $PIECE(BDWT,U,BDWY)=X
- End DoDot:1
- +9 QUIT BDWT
- VA ;EP
- +1 SET BDWVIEN=BDW("V DFN")
- +2 SET BDWPDFN=$PIECE($GET(^AUPNVSIT(BDWVIEN,0)),U,5)
- +3 IF BDWPDFN=""
- QUIT ""
- +4 SET BDWUVID=$$UIDV^BDWAID(BDWVIEN)
- +5 SET BDWVAX=$$VREC(BDWVIEN,"V000",BDWPDFN,0)
- +6 DO SET
- +7 KILL BDWVAY
- DO PROV^BDWUTIL1(.BDWVAY,BDWVIEN)
- +8 IF $GET(BDWVAY(1))=""
- Begin DoDot:1
- +9 SET BDWVAX="V010"_U_BDWUVID_U_"1^^^"
- DO SET
- End DoDot:1
- +10 SET BDWVAY=0
- FOR
- SET BDWVAY=$ORDER(BDWVAY(BDWVAY))
- IF BDWVAY'=+BDWVAY
- QUIT
- Begin DoDot:1
- +11 SET BDWVAX="V010"_U_BDWUVID_U_BDWVAY_U_$EXTRACT($PIECE(BDWVAY(BDWVAY),U,3))_U_$EXTRACT($PIECE(BDWVAY(BDWVAY),U,3),2,3)_U_$PIECE(BDWVAY(BDWVAY),U,8)
- +12 DO SET
- +13 QUIT
- End DoDot:1
- +14 KILL BDWVAY
- DO CPT^BDWUTIL(.BDWVAY,BDWVIEN)
- +15 SET BDWVAY=0
- FOR
- SET BDWVAY=$ORDER(BDWVAY(BDWVAY))
- IF BDWVAY'=+BDWVAY
- QUIT
- Begin DoDot:1
- +16 SET BDWVAX="V025"_U_BDWUVID_U_BDWVAY_U_$PIECE(BDWVAY(BDWVAY),U)_U_$PIECE(BDWVAY(BDWVAY),U,2)
- +17 DO SET
- +18 QUIT
- End DoDot:1
- +19 KILL BDWVAY
- DO PROC^BDWUTIL1(.BDWVAY,BDWVIEN)
- +20 SET BDWVAY=0
- FOR
- SET BDWVAY=$ORDER(BDWVAY(BDWVAY))
- IF BDWVAY'=+BDWVAY
- QUIT
- Begin DoDot:1
- +21 SET BDWVAX="V020"_U_BDWUVID_U_BDWVAY_U_$PIECE(BDWVAY(BDWVAY),U)_U_$$DATE^INHUT($PIECE(BDWVAY(BDWVAY),U,2))_U_$PIECE(BDWVAY(BDWVAY),U,6)
- +22 DO SET
- +23 QUIT
- End DoDot:1
- +24 KILL BDWVAY
- DO DENT^BDWUTIL(.BDWVAY,BDWVIEN)
- +25 SET BDWVAY=0
- FOR
- SET BDWVAY=$ORDER(BDWVAY(BDWVAY))
- IF BDWVAY'=+BDWVAY
- QUIT
- Begin DoDot:1
- +26 SET BDWVAX="V030"_U_BDWUVID_U_BDWVAY_U_$PIECE(BDWVAY(BDWVAY),U)_U_$PIECE(BDWVAY(BDWVAY),U,2)_U_$PIECE(BDWVAY(BDWVAY),U,3)
- +27 DO SET
- +28 QUIT
- End DoDot:1
- +29 KILL BDWVAY
- DO POVS^BDWUTIL(.BDWVAY,BDWVIEN)
- +30 SET BDWVAY=0
- FOR
- SET BDWVAY=$ORDER(BDWVAY(BDWVAY))
- IF BDWVAY'=+BDWVAY
- QUIT
- Begin DoDot:1
- +31 SET BDWVAX="V040"_U_BDWUVID_U_BDWVAY_U_$PIECE(BDWVAY(BDWVAY),U)_U_$PIECE(BDWVAY(BDWVAY),U,2)_U_$PIECE(BDWVAY(BDWVAY),U,3)_U_$PIECE(BDWVAY(BDWVAY),U,4)
- +32 DO SET
- +33 QUIT
- End DoDot:1
- +34 QUIT
- +35 ;
- SET ;
- +1 SET BDWVA("COUNT")=BDWVA("COUNT")+1
- +2 IF BDWVA("COUNT")=1
- SET ^BDWDATA(BDWVA("COUNT"))="H0^"_$PIECE($$DATE^INHUT($$NOW^XLFDT,1),"-",1)
- SET BDWVA("COUNT")=BDWVA("COUNT")+1
- +3 SET ^BDWDATA(BDWVA("COUNT"))=BDWVAX
- +4 QUIT
