BDWRDR21.m

BDWRDR21 ; IHS/CMI/LAB - CONT PROCESS ;

 ;;1.0;IHS DATA WAREHOUSE;;JAN 23, 2006

 ;

DEM ;EP

 S BDWV("PATIENT DFN")=$P(BDWV("V REC"),U,5) I BDWV("PATIENT DFN")="" S BDWE("ERROR")="104" D ^BDWRERR Q

 S Y=BDWV("PATIENT DFN") D ^AUPNPAT

 S BDWV("PATIENT NAME")=$P(^DPT(BDWV("PATIENT DFN"),0),U)

 Q:BDWV("PATIENT NAME")["DEMO,PATIENT"  ;IHS/CMI/LAB - changed to "[" from "="

 Q

SEX ;

 I AUPNSEX="" S BDWE("ERROR")="E601" Q

DOB ;

 I AUPNDOB="" S BDWE("ERROR")="E600" Q

 S X2=AUPNDOB,X1=BDWV("V DATE") D ^%DTC S AUPNDAYS=X

 I '$D(^AUPNPAT(AUPNPAT,11)) S BDWE("ERROR")="E602" Q

COMM ;

 S BDWV("COMMX")=0,BDWV("COMMPX")="" F  S BDWV("COMMX")=$O(^AUPNPAT(AUPNPAT,51,BDWV("COMMX"))) Q:BDWV("COMMX")'=+BDWV("COMMX")  S BDWV("COMMPX")=BDWV("COMMX")

 I BDWV("COMMPX")="" S BDWE("ERROR")="E610" Q

 S BDWV("COMMPX")=$P(^AUPNPAT(AUPNPAT,51,BDWV("COMMPX"),0),U,3) I BDWV("COMMPX")="" S BDWE("ERROR")="E611" Q

 I '$D(^AUTTCOM(BDWV("COMMPX"),0)) S BDWE("ERROR")="E611" Q

 I BDWV("COMMPX")]"" S BDWV("COMM CODE")=$P(^AUTTCOM(BDWV("COMMPX"),0),U,8) I BDWV("COMM CODE")="" S BDWE("ERROR")="E612" Q

TRIBE ;

 S X=$P(^AUPNPAT(AUPNPAT,11),U,8) I X="" S BDWE("ERROR")="E605" D RESET Q

 I $P(^AUTTTRI(X,0),U,4)="Y" S BDWE("ERROR")="E607" D RESET Q

 S BDWV("TRIBE CODE")=$P(^AUTTTRI(X,0),U,2) I BDWV("TRIBE CODE")="" S BDWE("ERROR")="E608" Q

CHART S (BDWV("T-HASF"),BDWV("CHART"))=""

 I $D(^AUPNPAT(BDWV("PATIENT DFN"),41,BDWV("LOC DFN"),0))#2 S BDWV("T-HASF")=$P(^(0),U),BDWV("CHART")=$P(^(0),U,2)

 I BDWV("CHART")="" S BDWV("CHART")=999999 Q

 S BDWV("CHART")=$E("000000",1,6-$L(BDWV("CHART")))_BDWV("CHART")

 Q

 ;

RESET ;EP

 Q:$P(BDWV("V REC"),U,11)

 S DA=BDW("V DFN"),DIE="^AUPNVSIT(",DR=".13///"_DT D ^DIE K DA,DIU,DIE,DR,DIV

 Q

BDWRDR21  ; IHS/CMI/LAB - CONT PROCESS ;

 +1       ;;1.0;IHS DATA WAREHOUSE;;JAN 23, 2006

 +2       ;

DEM       ;EP

 +1        SET BDWV("PATIENT DFN")=$PIECE(BDWV("V REC"),U,5)

           IF BDWV("PATIENT DFN")=""

               SET BDWE("ERROR")="104"

               DO ^BDWRERR

               QUIT 

 +2        SET Y=BDWV("PATIENT DFN")

           DO ^AUPNPAT

 +3        SET BDWV("PATIENT NAME")=$PIECE(^DPT(BDWV("PATIENT DFN"),0),U)

 +4       ;IHS/CMI/LAB - changed to "[" from "="

           IF BDWV("PATIENT NAME")["DEMO,PATIENT"

               QUIT 

 +5        QUIT 

SEX       ;

 +1        IF AUPNSEX=""

               SET BDWE("ERROR")="E601"

               QUIT 

DOB       ;

 +1        IF AUPNDOB=""

               SET BDWE("ERROR")="E600"

               QUIT 

 +2        SET X2=AUPNDOB

           SET X1=BDWV("V DATE")

           DO ^%DTC

           SET AUPNDAYS=X

 +3        IF '$DATA(^AUPNPAT(AUPNPAT,11))

               SET BDWE("ERROR")="E602"

               QUIT 

COMM      ;

 +1        SET BDWV("COMMX")=0

           SET BDWV("COMMPX")=""

           FOR 

               SET BDWV("COMMX")=$ORDER(^AUPNPAT(AUPNPAT,51,BDWV("COMMX")))

               IF BDWV("COMMX")'=+BDWV("COMMX")

                   QUIT 

               SET BDWV("COMMPX")=BDWV("COMMX")

 +2        IF BDWV("COMMPX")=""

               SET BDWE("ERROR")="E610"

               QUIT 

 +3        SET BDWV("COMMPX")=$PIECE(^AUPNPAT(AUPNPAT,51,BDWV("COMMPX"),0),U,3)

           IF BDWV("COMMPX")=""

               SET BDWE("ERROR")="E611"

               QUIT 

 +4        IF '$DATA(^AUTTCOM(BDWV("COMMPX"),0))

               SET BDWE("ERROR")="E611"

               QUIT 

 +5        IF BDWV("COMMPX")]""

               SET BDWV("COMM CODE")=$PIECE(^AUTTCOM(BDWV("COMMPX"),0),U,8)

               IF BDWV("COMM CODE")=""

                   SET BDWE("ERROR")="E612"

                   QUIT 

TRIBE     ;

 +1        SET X=$PIECE(^AUPNPAT(AUPNPAT,11),U,8)

           IF X=""

               SET BDWE("ERROR")="E605"

               DO RESET

               QUIT 

 +2        IF $PIECE(^AUTTTRI(X,0),U,4)="Y"

               SET BDWE("ERROR")="E607"

               DO RESET

               QUIT 

 +3        SET BDWV("TRIBE CODE")=$PIECE(^AUTTTRI(X,0),U,2)

           IF BDWV("TRIBE CODE")=""

               SET BDWE("ERROR")="E608"

               QUIT 

CHART      SET (BDWV("T-HASF"),BDWV("CHART"))=""

 +1        IF $DATA(^AUPNPAT(BDWV("PATIENT DFN"),41,BDWV("LOC DFN"),0))#2

               SET BDWV("T-HASF")=$PIECE(^(0),U)

               SET BDWV("CHART")=$PIECE(^(0),U,2)

 +2        IF BDWV("CHART")=""

               SET BDWV("CHART")=999999

               QUIT 

 +3        SET BDWV("CHART")=$EXTRACT("000000",1,6-$LENGTH(BDWV("CHART")))_BDWV("CHART")

 +4        QUIT 

 +5       ;

RESET     ;EP

 +1        IF $PIECE(BDWV("V REC"),U,11)

               QUIT 

 +2        SET DA=BDW("V DFN")

           SET DIE="^AUPNVSIT("

           SET DR=".13///"_DT

           DO ^DIE

           KILL DA,DIU,DIE,DR,DIV

 +3        QUIT