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
