BDWDDR2.m

BDWDDR2 ; IHS/CMI/LAB - reexport in date range ;

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

 ;

 ;

GENREC ;

DELSTAT ;generate new delimited format of the statistical record

 S BDWUSED=BDWUSED+1 ;total number of visits used

 S BDW("X")=$$VREC(BDWVIEN,"DATA WAREHOUSE RECORD 1")

 D SETTMP

 S BDW("X")=$$VREC(BDWVIEN,"DATA WAREHOUSE RECORD 2")

 D SETTMP

 S BDW("X")=$$VREC(BDWVIEN,"DATA WAREHOUSE RECORD 3")

 D SETTMP

 ;cpt records

 K AUPNCPT S X=$$CPT^AUPNCPT(BDWVIEN)

 I $D(AUPNCPT) D

 .S (X,BDWV("CPT COUNT"))=0 F  S X=$O(AUPNCPT(X)) Q:X'=+X  S BDWV("CPT COUNT")=BDWV("CPT COUNT")+1

 .S BDWV("CPT RECS")=$S(BDWV("CPT COUNT")#25=0:BDWV("CPT COUNT")/25,1:(BDWV("CPT COUNT")\25)+1) ;IHS/CMI/LAB

 .F BDWV("CPT X")=1:1:BDWV("CPT RECS") D

 ..S P=1,Y=(BDWV("CPT X")*25)-25 K BDWV("CPT SET") F  S Y=$O(AUPNCPT(Y)) Q:Y=""!(Y>(BDWV("CPT X")*25))  S $P(BDWV("CPT SET"),U,P)=$P(AUPNCPT(Y),U)_"^" D  S P=P+2

 ...;Q:$P(AUPNCPT(Y),U,4)'=9000010.18

 ...I $P(AUPNCPT(Y),U,4)=9000010.18 S E=$P(AUPNCPT(Y),U,5) S $P(BDWV("CPT SET"),U,(P+1))=$P($G(^AUPNVCPT(E,0)),U,16)

 ..S BDW("X")=$$VREC(BDWVIEN,"DATA WAREHOUSE RECORD 4",BDWV("CPT SET"),BDWV("CPT X"))

 ..D SETTMP

 K AUPNCPT

 S ^TMP($J,"BDW",BDWVIEN)=BDW("MAIN TX DATE")

 Q

 ;

SETTMP ;

 S BDWTOTR=BDWTOTR+1

 S ^BDWPDATA(BDWTOTR)=BDW("X")

 Q

VREC(BDWVIEN,BDWRTYP,BDWVAR1,BDWVAR2,BDWVAR3,BDWVAR4,BDWVAR5,BDWVAR6) ;generate 1 record delimited format

 S BDWVREC=^AUPNVSIT(BDWVIEN,0)

 S DFN=$P(^AUPNVSIT(BDWVIEN,0),U,5)

 NEW BDWRIEN S BDWRIEN=$O(^BDWREC("B",BDWRTYP,0))

 I 'BDWRIEN Q ""

 NEW BDWY,BDWT S BDWY=0,BDWT="" F  S BDWY=$O(^BDWREC(BDWRIEN,11,"B",BDWY)) Q:BDWY'=+BDWY  D

 .S X=""

 .NEW BDWZ S BDWZ=$O(^BDWREC(BDWRIEN,11,"B",BDWY,0))

 .Q:'$D(^BDWREC(BDWRIEN,11,BDWZ,1))

 .X ^BDWREC(BDWRIEN,11,BDWZ,1)

 .S $P(BDWT,U,BDWY)=X

 .;S LORICNT=LORICNT+1,^LORITEST(LORICNT)=BDWVIEN_"^"_$P(^BDWREC(BDWRIEN,11,BDWZ,0),U,1)_"^"_$P(^BDWREC(BDWRIEN,11,BDWZ,0),U,2)_"^"_X

 Q BDWT

BDWDDR2   ; IHS/CMI/LAB - reexport in date range ;

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

 +2       ;

 +3       ;

GENREC    ;

DELSTAT   ;generate new delimited format of the statistical record

 +1       ;total number of visits used

           SET BDWUSED=BDWUSED+1

 +2        SET BDW("X")=$$VREC(BDWVIEN,"DATA WAREHOUSE RECORD 1")

 +3        DO SETTMP

 +4        SET BDW("X")=$$VREC(BDWVIEN,"DATA WAREHOUSE RECORD 2")

 +5        DO SETTMP

 +6        SET BDW("X")=$$VREC(BDWVIEN,"DATA WAREHOUSE RECORD 3")

 +7        DO SETTMP

 +8       ;cpt records

 +9        KILL AUPNCPT

           SET X=$$CPT^AUPNCPT(BDWVIEN)

 +10       IF $DATA(AUPNCPT)

               Begin DoDot:1

 +11               SET (X,BDWV("CPT COUNT"))=0

                   FOR 

                       SET X=$ORDER(AUPNCPT(X))

                       IF X'=+X

                           QUIT 

                       SET BDWV("CPT COUNT")=BDWV("CPT COUNT")+1

 +12      ;IHS/CMI/LAB

                   SET BDWV("CPT RECS")=$SELECT(BDWV("CPT COUNT")#25=0:BDWV("CPT COUNT")/25,1:(BDWV("CPT COUNT")\25)+1)

 +13               FOR BDWV("CPT X")=1:1:BDWV("CPT RECS")

                       Begin DoDot:2

 +14                       SET P=1

                           SET Y=(BDWV("CPT X")*25)-25

                           KILL BDWV("CPT SET")

                           FOR 

                               SET Y=$ORDER(AUPNCPT(Y))

                               IF Y=""!(Y>(BDWV("CPT X")*25))

                                   QUIT 

                               SET $PIECE(BDWV("CPT SET"),U,P)=$PIECE(AUPNCPT(Y),U)_"^"

                               Begin DoDot:3

 +15      ;Q:$P(AUPNCPT(Y),U,4)'=9000010.18

 +16                               IF $PIECE(AUPNCPT(Y),U,4)=9000010.18

                                       SET E=$PIECE(AUPNCPT(Y),U,5)

                                       SET $PIECE(BDWV("CPT SET"),U,(P+1))=$PIECE($GET(^AUPNVCPT(E,0)),U,16)

                               End DoDot:3

                               SET P=P+2

 +17                       SET BDW("X")=$$VREC(BDWVIEN,"DATA WAREHOUSE RECORD 4",BDWV("CPT SET"),BDWV("CPT X"))

 +18                       DO SETTMP

                       End DoDot:2

               End DoDot:1

 +19       KILL AUPNCPT

 +20       SET ^TMP($JOB,"BDW",BDWVIEN)=BDW("MAIN TX DATE")

 +21       QUIT 

 +22      ;

SETTMP    ;

 +1        SET BDWTOTR=BDWTOTR+1

 +2        SET ^BDWPDATA(BDWTOTR)=BDW("X")

 +3        QUIT 

VREC(BDWVIEN,BDWRTYP,BDWVAR1,BDWVAR2,BDWVAR3,BDWVAR4,BDWVAR5,BDWVAR6) ;generate 1 record delimited format

 +1        SET BDWVREC=^AUPNVSIT(BDWVIEN,0)

 +2        SET DFN=$PIECE(^AUPNVSIT(BDWVIEN,0),U,5)

 +3        NEW BDWRIEN

           SET BDWRIEN=$ORDER(^BDWREC("B",BDWRTYP,0))

 +4        IF 'BDWRIEN

               QUIT ""

 +5        NEW BDWY,BDWT

           SET BDWY=0

           SET BDWT=""

           FOR 

               SET BDWY=$ORDER(^BDWREC(BDWRIEN,11,"B",BDWY))

               IF BDWY'=+BDWY

                   QUIT 

               Begin DoDot:1

 +6                SET X=""

 +7                NEW BDWZ

                   SET BDWZ=$ORDER(^BDWREC(BDWRIEN,11,"B",BDWY,0))

 +8                IF '$DATA(^BDWREC(BDWRIEN,11,BDWZ,1))

                       QUIT 

 +9                XECUTE ^BDWREC(BDWRIEN,11,BDWZ,1)

 +10               SET $PIECE(BDWT,U,BDWY)=X

 +11      ;S LORICNT=LORICNT+1,^LORITEST(LORICNT)=BDWVIEN_"^"_$P(^BDWREC(BDWRIEN,11,BDWZ,0),U,1)_"^"_$P(^BDWREC(BDWRIEN,11,BDWZ,0),U,2)_"^"_X

               End DoDot:1

 +12       QUIT BDWT