Routine: BDWRDR2

BDWRDR2 ; IHS/CMI/LAB - DW PROCESS VISIT ;

 ;;1.0;IHS DATA WAREHOUSE;**2,4**;JAN 23, 2006;Build 24

 K BDWE

 D VISIT

 I $D(BDWE) D ^BDWRERR Q

 D PROCTX

 K BDWE,BDWT,BDWH

VISIT ;EP

 I $P(BDWV("V REC"),U,23)=.5 S BDW("MFI")=BDW("MFI")+1,BDWE("ERROR")=120 Q

 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

 I '$D(^AUTTLOC(BDWV("LOC DFN"),0)) S BDWE("ERROR")="111",BDW("NO LOC")=BDW("NO LOC")+1 Q

 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"))) S BDWE("ERROR")="104",BDW("NO PAT")=BDW("NO PAT")+1 Q

 I '$D(^AUPNPAT(BDWV("PATIENT DFN"))) 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

PROCTX ; process and generate appropriate hl7 message

 S BDW("VISITS")=$G(BDW("VISITS"))+1

 I '$G(BDWDDR) S BDWV("TX GENERATED")=1,^XTMP("BDW"_$S(BDWO("RUN")="NEW":"DR",BDWO("RUN")="REDO":"REDO",1:"DR"),"MAIN TX",BDW("V DFN"))=BDW("MAIN TX DATE")

 I $G(BDWDDR) S BDWV("TX GENERATED")=1,^TMP($J,"BDW",BDW("V DFN"))=BDW("MAIN TX DATE")

 S ^XTMP("BDWALPMR",$J,BDWV("PATIENT DFN"))=""  ;p5 add set so patient centric messages can run later

 S BDWVMSG=$$DW1A08^BHLEVENT(BDW("V DFN"))

 S ^BDWTMP(BDWIEDST,BDWVMSG)=""

 S X=$P(^AUPNVSIT(BDW("V DFN"),0),U,3)_"-"_$E($$EXTSET^XBFUNC(9000010,.03,$P(^AUPNVSIT(BDW("V DFN"),0),U,3)),1,9)_"/"_$P(^AUPNVSIT(BDW("V DFN"),0),U,7)_"-"_$E($$EXTSET^XBFUNC(9000010,.07,$P(^AUPNVSIT(BDW("V DFN"),0),U,7)),1,17)

 S Y=$S($P(^AUPNVSIT(BDW("V DFN"),0),U,11):"D",$P(^AUPNVSIT(BDW("V DFN"),11),U,6)]"":"M",1:"A")

 S ^TMP($J,"BDWTRAILER",$P(^AUPNVSIT(BDW("V DFN"),0),U,6),"TYPE",X,Y)=$G(^TMP($J,"BDWTRAILER",$P(^AUPNVSIT(BDW("V DFN"),0),U,6),"TYPE",X,Y))+1

 S ^TMP($J,"BDWTRAILER",$P(^AUPNVSIT(BDW("V DFN"),0),U,6),"TYPE",X,"TOT")=$G(^TMP($J,"BDWTRAILER",$P(^AUPNVSIT(BDW("V DFN"),0),U,6),"TYPE",X,"TOT"))+1

 S ^TMP($J,"BDWTRAILER",$P(^AUPNVSIT(BDW("V DFN"),0),U,6),"DATE",X,$E($P(^AUPNVSIT(BDW("V DFN"),0),U),1,5)_"00")=$G(^TMP($J,"BDWTRAILER",$P(^AUPNVSIT(BDW("V DFN"),0),U,6),"DATE",X,$E($P(^AUPNVSIT(BDW("V DFN"),0),U),1,5)_"00"))+1

 ;call audit

 I $P(^AUPNVSIT(BDW("V DFN"),0),U,11) S BDW("DELS")=BDW("DELS")+1 Q

 I $P(^AUPNVSIT(BDW("V DFN"),11),U,6)]"" S BDW("MODS")=BDW("MODS")+1 Q

 S BDW("ADDS")=BDW("ADDS")+1

ALPMR ;-- process ALPMR patient centric messages

 ;the following is for testing all patients

 ;N BDA

 ;S BDA=0 F  S BDA=$O(^DPT(BDA)) Q:'BDA  D

 ;. S ^XTMP("BDWALPMR",$J,BDA)=""

 N BDWADA,BDWAMSG

 S BDW("ALPMR")=0,BDWCNTR=0

 W:'$D(ZTQUEUED) !,"Generating transactions.  Counting patient centric records.  (0)"

 S BDWADA=0 F  S BDWADA=$O(^XTMP("BDWALPMR",$J,BDWADA)) Q:'BDWADA  D

 . I '$$CHKALPMR(BDWADA) K ^XTMP("BDWALPMR",$J,BDWADA) Q

 . S BDW("ALPMR")=BDW("ALPMR")+1

 . S BDWAMSG=$$DW1ALPMR^BDWBHL1(BDWADA)

 . S ^BDWTMP(BDWIEDST,BDWAMSG)=""

 . D SET61(BDW("RUN LOG"),BDWADA,BDWAMSG)

 . X BDWCNT

 K ^XTMP("BDWALPMR",$J)

SET61(RL,ADA,AMSG)  ;--lets set the log here

 S:'$D(^BDWXLOG(RL,61,0)) ^BDWXLOG(RL,61,0)="^90213.06101PA^^"

 S ^BDWXLOG(RL,61,ADA,0)=ADA_U_$G(AMSG)

 S $P(^BDWXLOG(RL,61,0),U,3)="",$P(^(0),U,4)=$P(^(0),U,4)+1

CHKALPMR(ADA) ;-- check to see if the patient has any data for ALPMR

 I $D(^AUPNPROB("AC",ADA)) Q 1

 I $D(^AUPNPREF("AC",ADA)) Q 1

 I $D(^BIPC("B",ADA)) Q 1

 I $D(^BWPCD("C",ADA)) Q 1

Q 0

BDWRDR2   ; IHS/CMI/LAB - DW PROCESS VISIT ;

 +1       ;;1.0;IHS DATA WAREHOUSE;**2,4**;JAN 23, 2006;Build 24

 +2       ;

 +3        KILL BDWE

 +4        DO VISIT

 +5        IF $DATA(BDWE)

               DO ^BDWRERR

               QUIT

 +6        DO PROCTX

 +7        KILL BDWE,BDWT,BDWH

 +8        QUIT

 +9       ;

VISIT     ;EP

 +1        IF $PIECE(BDWV("V REC"),U,23)=.5

               SET BDW("MFI")=BDW("MFI")+1

               SET BDWE("ERROR")=120

               QUIT

 +2        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

 +3        SET BDWV("TYPE")=$PIECE(BDWV("V REC"),U,3)

 +4        IF BDWV("TYPE")=""

               SET BDWE("ERROR")="130"

               SET BDW("NO TYPE")=BDW("NO TYPE")+1

               QUIT

 +5        SET BDWV("SRV CAT")=$PIECE(BDWV("V REC"),U,7)

 +6        IF BDWV("SRV CAT")=""

               SET BDWE("ERROR")="132"

               SET BDW("NO CAT")=BDW("NO CAT")+1

               QUIT

 +7        SET BDWV("LOC DFN")=$PIECE(BDWV("V REC"),U,6)

 +8        IF BDWV("LOC DFN")=""

               SET BDWE("ERROR")="111"

               SET BDW("NO LOC")=BDW("NO LOC")+1

               QUIT

 +9        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")))

               SET BDWE("ERROR")="104"

               SET BDW("NO PAT")=BDW("NO PAT")+1

               QUIT

 +13       IF '$DATA(^AUPNPAT(BDWV("PATIENT DFN")))

               SET BDWE("ERROR")="104"

               SET BDW("NO PAT")=BDW("NO PAT")+1

               QUIT

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

           DO ^AUPNPAT

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

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

               SET BDW("DEMO")=BDW("DEMO")+1

               SET BDWE("ERROR")=101

               QUIT

 +17       QUIT

 +18      ;

PROCTX    ; process and generate appropriate hl7 message

 +1        SET BDW("VISITS")=$GET(BDW("VISITS"))+1

 +2        IF '$GET(BDWDDR)

               SET BDWV("TX GENERATED")=1

               SET ^XTMP("BDW"_$SELECT(BDWO("RUN")="NEW":"DR",BDWO("RUN")="REDO":"REDO",1:"DR"),"MAIN TX",BDW("V DFN"))=BDW("MAIN TX DATE")

 +3        IF $GET(BDWDDR)

               SET BDWV("TX GENERATED")=1

               SET ^TMP($JOB,"BDW",BDW("V DFN"))=BDW("MAIN TX DATE")

 +4       ;p5 add set so patient centric messages can run later

           SET ^XTMP("BDWALPMR",$JOB,BDWV("PATIENT DFN"))=""

 +5        SET BDWVMSG=$$DW1A08^BHLEVENT(BDW("V DFN"))

 +6        SET ^BDWTMP(BDWIEDST,BDWVMSG)=""

 +7       SET X=$PIECE(^AUPNVSIT(BDW("V DFN"),0),U,3)_"-"_$EXTRACT($$EXTSET^XBFUNC(9000010,.03,$PIECE(^AUPNVSIT(BDW("V DFN"),0),U,3)),1,9)_"/"_$PIECE(^AUPNVSIT(BDW("V DFN"),0),U,7)_"-"_$EXTRACT($$EXTSET^XBFUNC(9000010,.07,...

           ... $PIECE(^AUPNVSIT(BDW("V DFN"),0),U,7)),1,17)

 +8        SET Y=$SELECT($PIECE(^AUPNVSIT(BDW("V DFN"),0),U,11):"D",$PIECE(^AUPNVSIT(BDW("V DFN"),11),U,6)]"":"M",1:"A")

 +9        SET ^TMP($JOB,"BDWTRAILER",$PIECE(^AUPNVSIT(BDW("V DFN"),0),U,6),"TYPE",X,Y)=$GET(^TMP($JOB,"BDWTRAILER",$PIECE(^AUPNVSIT(BDW("V DFN"),0),U,6),"TYPE",X,Y))+1

 +10       SET ^TMP($JOB,"BDWTRAILER",$PIECE(^AUPNVSIT(BDW("V DFN"),0),U,6),"TYPE",X,"TOT")=$GET(^TMP($JOB,"BDWTRAILER",$PIECE(^AUPNVSIT(BDW("V DFN"),0),U,6),"TYPE",X,"TOT"))+1

 +11      SET ^TMP($JOB,"BDWTRAILER",$PIECE(^AUPNVSIT(BDW("V DFN"),0),U,6),"DATE",X,$EXTRACT($PIECE(^AUPNVSIT(BDW("V DFN"),0),U),1,5)_"00")=$GET(^TMP($JOB,"BDWTRAILER",$PIECE(^AUPNVSIT(BDW("V DFN"),0),U,6),"DATE",X,...

           ... $EXTRACT($PIECE(^AUPNVSIT(BDW("V DFN"),0),U),1,5)_"00"))+1

 +12      ;call audit

 +13       IF $PIECE(^AUPNVSIT(BDW("V DFN"),0),U,11)

               SET BDW("DELS")=BDW("DELS")+1

               QUIT

 +14       IF $PIECE(^AUPNVSIT(BDW("V DFN"),11),U,6)]""

               SET BDW("MODS")=BDW("MODS")+1

               QUIT

 +15       SET BDW("ADDS")=BDW("ADDS")+1

 +16       QUIT

 +17      ;

ALPMR     ;-- process ALPMR patient centric messages

 +1       ;the following is for testing all patients

 +2       ;N BDA

 +3       ;S BDA=0 F  S BDA=$O(^DPT(BDA)) Q:'BDA  D

 +4       ;. S ^XTMP("BDWALPMR",$J,BDA)=""

 +5        NEW BDWADA,BDWAMSG

 +6        SET BDW("ALPMR")=0

           SET BDWCNTR=0

 +7        IF '$DATA(ZTQUEUED)

               WRITE !,"Generating transactions.  Counting patient centric records.  (0)"

 +8        SET BDWADA=0

FOR

               SET BDWADA=$ORDER(^XTMP("BDWALPMR",$JOB,BDWADA))

               IF 'BDWADA

                   QUIT

               Begin DoDot:1

 +9                IF '$$CHKALPMR(BDWADA)

                       KILL ^XTMP("BDWALPMR",$JOB,BDWADA)

                       QUIT

 +10               SET BDW("ALPMR")=BDW("ALPMR")+1

 +11               SET BDWAMSG=$$DW1ALPMR^BDWBHL1(BDWADA)

 +12               SET ^BDWTMP(BDWIEDST,BDWAMSG)=""

 +13               DO SET61(BDW("RUN LOG"),BDWADA,BDWAMSG)

 +14               XECUTE BDWCNT

               End DoDot:1

 +15       KILL ^XTMP("BDWALPMR",$JOB)

 +16       QUIT

 +17      ;

SET61(RL,ADA,AMSG) ;--lets set the log here

 +1        IF '$DATA(^BDWXLOG(RL,61,0))

               SET ^BDWXLOG(RL,61,0)="^90213.06101PA^^"

 +2        SET ^BDWXLOG(RL,61,ADA,0)=ADA_U_$GET(AMSG)

 +3        SET $PIECE(^BDWXLOG(RL,61,0),U,3)=""

           SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1

 +4        QUIT

 +5       ;

CHKALPMR(ADA) ;-- check to see if the patient has any data for ALPMR

 +1        IF $DATA(^AUPNPROB("AC",ADA))

               QUIT 1

 +2        IF $DATA(^AUPNPREF("AC",ADA))

               QUIT 1

 +3        IF $DATA(^BIPC("B",ADA))

               QUIT 1

 +4        IF $DATA(^BWPCD("C",ADA))

               QUIT 1

 +5        QUIT 0

 +6       ;

BDWRDR2.m