BDWSR2.m

BDWSR2 ; IHS/CMI/LAB - DW REPORT 2 ;

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

 ;IHS/TUCSON/LAB - patch 3 made file 200 compatible

TYPE ;EP

 K ^UTILITY("DIQ1",$J)

 K DIQ,DIC,DA,DR

 S DIC="^AUPNVSIT(",DR=".03",DA=BDWSR("V"),DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ

 S BDWSR("TYPE")=^UTILITY("DIQ1",$J,9000010,BDWSR("V"),.03,"E")

 S X="^XTMP("_BDWSR("PROC")_",BDWVAR,BDWSR(""TYPE""))" D COUNT

 Q

SC ;EP

 K ^UTILITY("DIQ1",$J)

 K DIQ,DIC,DA,DR

 S DIC="^AUPNVSIT(",DR=".07",DA=BDWSR("V"),DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ

 S BDWSR("SC")=^UTILITY("DIQ1",$J,9000010,BDWSR("V"),.07,"E")

 S X="^XTMP("_BDWSR("PROC")_",BDWVAR,BDWSR(""SC""))" D COUNT

 K ^UTILITY("DIQ1",$J)

 Q

CLINIC ;EP

 S BDWSR("CLN")=$P(^AUPNVSIT(BDWSR("V"),0),U,8) I BDWSR("CLN")="" S BDWSR("CLN")="NO CLINIC",BDWSR("CLN CODE")="" G SETCLIN

 S BDWSR("CLN CODE")=$P(^DIC(40.7,BDWSR("CLN"),0),U,2),BDWSR("CLN")=$P(^DIC(40.7,BDWSR("CLN"),0),U)

 ;I BDWSR("CLN CODE")=56,$D(^AUPNVMED("AD",BDWSR("V"))),BDWVAR="CLINIC" D DENTAL^BDWSR1 S BDWSR("CLN")=BDWSR("PHARM NAME"),BDWSR("CLN CODE")=39

 ;Q:BDWSR("CLN CODE")=56

SETCLIN ;EP

 S X="^XTMP("_BDWSR("PROC")_",BDWVAR,BDWSR(""CLN""))" D COUNT

 ;

 Q

LOC ;EP

 S BDWSR("LOC")=$P(^AUPNVSIT(BDWSR("V"),0),U,6)

 S X="^XTMP("_BDWSR("PROC")_",BDWVAR,BDWSR(""LOC""))" D COUNT

 ;

 Q

PROV ;EP -provider type

 S BDWSR("X")=0 F  S BDWSR("X")=$O(^AUPNVPRV("AD",BDWSR("V"),BDWSR("X"))) Q:BDWSR("X")'=+BDWSR("X")  I $P(^AUPNVPRV(BDWSR("X"),0),U,4)="P" D PROV1

 Q

VD ;EP -tally by visit date

 S BDWSR("V DATE")=$P($P(^AUPNVSIT(BDWSR("V"),0),U),".")

 S X="^XTMP("_BDWSR("PROC")_",BDWVAR,BDWSR(""V DATE""))" D COUNT

 Q

PROV1 ;

 S BDWSR("PROV")=$P(^AUPNVPRV(BDWSR("X"),0),U)

 S BDWSR("DISC")=$$VAL^XBDIQ1(BDWS("PROV FILE"),BDWSR("PROV"),9999999.03)

 Q:BDWSR("DISC")=88

 Q:BDWSR("DISC")=""

 S BDWSR("DISC")=$$VAL^XBDIQ1(BDWS("PROV FILE"),BDWSR("PROV"),$S(BDWS("PROV FILE")=200:53.5,1:2))

 Q:BDWSR("DISC")=""

 S X="^XTMP("_BDWSR("PROC")_",BDWVAR,BDWSR(""DISC""))" D COUNT

 Q

 Q

COUNT ;

 I '$D(@X) S @X=0

 S %=@X,%=%+1,@X=%

 Q

C42 ;;

C51 ;

C52 ;;

C53 ;;

C54 ;;

C56 ;;

C60 ;;

C68 ;;

BDWSR2    ; IHS/CMI/LAB - DW REPORT 2 ;

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

 +2       ;IHS/TUCSON/LAB - patch 3 made file 200 compatible

TYPE      ;EP

 +1        KILL ^UTILITY("DIQ1",$JOB)

 +2        KILL DIQ,DIC,DA,DR

 +3        SET DIC="^AUPNVSIT("

           SET DR=".03"

           SET DA=BDWSR("V")

           SET DIQ(0)="E"

           DO EN^DIQ1

           KILL DIC,DA,DR,DIQ

 +4        SET BDWSR("TYPE")=^UTILITY("DIQ1",$JOB,9000010,BDWSR("V"),.03,"E")

 +5        SET X="^XTMP("_BDWSR("PROC")_",BDWVAR,BDWSR(""TYPE""))"

           DO COUNT

 +6        QUIT 

SC        ;EP

 +1        KILL ^UTILITY("DIQ1",$JOB)

 +2        KILL DIQ,DIC,DA,DR

 +3        SET DIC="^AUPNVSIT("

           SET DR=".07"

           SET DA=BDWSR("V")

           SET DIQ(0)="E"

           DO EN^DIQ1

           KILL DIC,DA,DR,DIQ

 +4        SET BDWSR("SC")=^UTILITY("DIQ1",$JOB,9000010,BDWSR("V"),.07,"E")

 +5        SET X="^XTMP("_BDWSR("PROC")_",BDWVAR,BDWSR(""SC""))"

           DO COUNT

 +6        KILL ^UTILITY("DIQ1",$JOB)

 +7        QUIT 

CLINIC    ;EP

 +1        SET BDWSR("CLN")=$PIECE(^AUPNVSIT(BDWSR("V"),0),U,8)

           IF BDWSR("CLN")=""

               SET BDWSR("CLN")="NO CLINIC"

               SET BDWSR("CLN CODE")=""

               GOTO SETCLIN

 +2        SET BDWSR("CLN CODE")=$PIECE(^DIC(40.7,BDWSR("CLN"),0),U,2)

           SET BDWSR("CLN")=$PIECE(^DIC(40.7,BDWSR("CLN"),0),U)

 +3       ;I BDWSR("CLN CODE")=56,$D(^AUPNVMED("AD",BDWSR("V"))),BDWVAR="CLINIC" D DENTAL^BDWSR1 S BDWSR("CLN")=BDWSR("PHARM NAME"),BDWSR("CLN CODE")=39

 +4       ;Q:BDWSR("CLN CODE")=56

SETCLIN   ;EP

 +1        SET X="^XTMP("_BDWSR("PROC")_",BDWVAR,BDWSR(""CLN""))"

           DO COUNT

 +2       ;

 +3        QUIT 

LOC       ;EP

 +1        SET BDWSR("LOC")=$PIECE(^AUPNVSIT(BDWSR("V"),0),U,6)

 +2        SET X="^XTMP("_BDWSR("PROC")_",BDWVAR,BDWSR(""LOC""))"

           DO COUNT

 +3       ;

 +4        QUIT 

PROV      ;EP -provider type

 +1        SET BDWSR("X")=0

           FOR 

               SET BDWSR("X")=$ORDER(^AUPNVPRV("AD",BDWSR("V"),BDWSR("X")))

               IF BDWSR("X")'=+BDWSR("X")

                   QUIT 

               IF $PIECE(^AUPNVPRV(BDWSR("X"),0),U,4)="P"

                   DO PROV1

 +2        QUIT 

VD        ;EP -tally by visit date

 +1        SET BDWSR("V DATE")=$PIECE($PIECE(^AUPNVSIT(BDWSR("V"),0),U),".")

 +2        SET X="^XTMP("_BDWSR("PROC")_",BDWVAR,BDWSR(""V DATE""))"

           DO COUNT

 +3        QUIT 

PROV1     ;

 +1        SET BDWSR("PROV")=$PIECE(^AUPNVPRV(BDWSR("X"),0),U)

 +2        SET BDWSR("DISC")=$$VAL^XBDIQ1(BDWS("PROV FILE"),BDWSR("PROV"),9999999.03)

 +3        IF BDWSR("DISC")=88

               QUIT 

 +4        IF BDWSR("DISC")=""

               QUIT 

 +5        SET BDWSR("DISC")=$$VAL^XBDIQ1(BDWS("PROV FILE"),BDWSR("PROV"),$SELECT(BDWS("PROV FILE")=200:53.5,1:2))

 +6        IF BDWSR("DISC")=""

               QUIT 

 +7        SET X="^XTMP("_BDWSR("PROC")_",BDWVAR,BDWSR(""DISC""))"

           DO COUNT

 +8        QUIT 

 +9        QUIT 

COUNT     ;

 +1        IF '$DATA(@X)

               SET @X=0

 +2        SET %=@X

           SET %=%+1

           SET @X=%

 +3        QUIT 

C42       ;;

C51       ;

C52       ;;

C53       ;;

C54       ;;

C56       ;;

C60       ;;

C68       ;;