PSULR1.m

PSULR1 ;BIR/PDW - PBM LAB EXTRACT ;12 AUG 1999

 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005

 ; Extract & setup crosswalk for drug codes and "CH" nodes

 ; Reference to File # 60  supported by DBIA 2523

 ; Reference to ^LAM       supported by DBIA 2522

EN ;EP  Tasking Entry Point for generating LAB mail messages, Summaries, & Prints

 ;

CODES ; Table for Building Class * Work Load codes * Lab Tests crosswalk

 D SETCODES^PSULR0

 ; Builds ^XTMP(PSULRSUB,"CODES",VA DRUG CLASS,LAB NODE LOCATION)=LAB TEST

 ; Builds PSUFLAG("BLOOD":"SERUM":"PLASMA") array

 S:'$D(PSUJOB) PSUJOB=$J

 S:'$D(PSULRJOB) PSULRJOB=PSUJOB

 S:'$D(PSULRSUB) PSULRSUB="PSULR_"_PSULRJOB

 ;    Initialize Flag type array

 F X="BLOOD","SERUM","PLASMA" S PSUFLAG(X)=""

 ;

 ;    Loop Drug Class Codes & WorkCodes    3.2.8.7

 S X="AN500" F Y=83405,81062 S PSULRX(X,Y)="" D GET

 S X="CV200" F Y=82565 S PSULRX(X,Y)="" D GET

 S X="CV350" F Y=83017,83013,84480,82466,84455,84465 S PSULRX(X,Y)="" D GET

 S X="CV800" F Y=82565,84140 S PSULRX(X,Y)="" D GET

 S X="GA301" F Y=82565 S PSULRX(X,Y)="" D GET

 S X="HS502" F Y=84330,85053,84455,84465,85052 S PSULRX(X,Y)="" D GET

 ;

 Q

 ;   Follow wrk code into tests 3.2.8.9

GET ;EP   Get the appropriate Work Load entry

 ;

 S PSUY=Y_".0000 " D WALK

 F  S PSUY=$O(^LAM("C",PSUY)) Q:(+PSUY\1'=+Y)  D WALK

 Q

WALK ;EP Do the crosswalk to get the tests associated with workload

 S Z=$O(^LAM("C",PSUY,0))

 ;    3.2.8.9

 I '$D(^LAM(Z,7,"B")) Q

 ;    3.2.8.10

 ;

 S PSUWKDA=Z

 ;    Loop Multiple & Work on over to file 60 & check site/specimen

 S Z="" F  S Z=$O(^LAM(PSUWKDA,7,"B",Z)) Q:Z=""  D

 . S PSULRDA=+Z

 . K PSUSPECM

 . D GETM^PSUTL(60,PSULRDA,"100*^.01;6","PSUSPECM")

 . S DA=0,PSUFLAG=0 F  S DA=$O(PSUSPECM(DA)) Q:DA'>0  S W=PSUSPECM(DA,.01) I $D(PSUFLAG(W)) S PSUFLAG=1 Q

 . Q:'PSUFLAG

 . ;  store DrugCode, WrkCode, Lab IEN = Location

 . S PSULOC=$$VAL^PSUTL(60,PSULRDA,5),PSULOC=$P(PSULOC,";",2)

 . ;S ^XTMP(PSULRSUB,"CODES",X,+Y,PSULRDA)=PSULOC ; Trace Construction

 . S ^XTMP(PSULRSUB,"CODES",X,PSULOC)=$$VAL^PSUTL(60,PSULRDA,.01)_U_PSUSPECM(DA,6)

PSULR1    ;BIR/PDW - PBM LAB EXTRACT ;12 AUG 1999

 +1       ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005

 +2       ; Extract & setup crosswalk for drug codes and "CH" nodes

 +3       ; Reference to File # 60  supported by DBIA 2523

 +4       ; Reference to ^LAM       supported by DBIA 2522

EN        ;EP  Tasking Entry Point for generating LAB mail messages, Summaries, & Prints

 +1       ;

CODES     ; Table for Building Class * Work Load codes * Lab Tests crosswalk

 +1        DO SETCODES^PSULR0

 +2       ; Builds ^XTMP(PSULRSUB,"CODES",VA DRUG CLASS,LAB NODE LOCATION)=LAB TEST

 +3       ; Builds PSUFLAG("BLOOD":"SERUM":"PLASMA") array

 +4        IF '$DATA(PSUJOB)

               SET PSUJOB=$JOB

 +5        IF '$DATA(PSULRJOB)

               SET PSULRJOB=PSUJOB

 +6        IF '$DATA(PSULRSUB)

               SET PSULRSUB="PSULR_"_PSULRJOB

 +7       ;    Initialize Flag type array

 +8        FOR X="BLOOD","SERUM","PLASMA"

               SET PSUFLAG(X)=""

 +9       ;

 +10      ;    Loop Drug Class Codes & WorkCodes    3.2.8.7

 +11       SET X="AN500"

           FOR Y=83405,81062

               SET PSULRX(X,Y)=""

               DO GET

 +12       SET X="CV200"

           FOR Y=82565

               SET PSULRX(X,Y)=""

               DO GET

 +13       SET X="CV350"

           FOR Y=83017,83013,84480,82466,84455,84465

               SET PSULRX(X,Y)=""

               DO GET

 +14       SET X="CV800"

           FOR Y=82565,84140

               SET PSULRX(X,Y)=""

               DO GET

 +15       SET X="GA301"

           FOR Y=82565

               SET PSULRX(X,Y)=""

               DO GET

 +16       SET X="HS502"

           FOR Y=84330,85053,84455,84465,85052

               SET PSULRX(X,Y)=""

               DO GET

 +17      ;

 +18       QUIT 

 +19      ;   Follow wrk code into tests 3.2.8.9

GET       ;EP   Get the appropriate Work Load entry

 +1       ;

 +2        SET PSUY=Y_".0000 "

           DO WALK

 +3        FOR 

               SET PSUY=$ORDER(^LAM("C",PSUY))

               IF (+PSUY\1'=+Y)

                   QUIT 

               DO WALK

 +4        QUIT 

WALK      ;EP Do the crosswalk to get the tests associated with workload

 +1        SET Z=$ORDER(^LAM("C",PSUY,0))

 +2       ;    3.2.8.9

 +3        IF '$DATA(^LAM(Z,7,"B"))

               QUIT 

 +4       ;    3.2.8.10

 +5       ;

 +6        SET PSUWKDA=Z

 +7       ;    Loop Multiple & Work on over to file 60 & check site/specimen

 +8        SET Z=""

           FOR 

               SET Z=$ORDER(^LAM(PSUWKDA,7,"B",Z))

               IF Z=""

                   QUIT 

               Begin DoDot:1

 +9                SET PSULRDA=+Z

 +10               KILL PSUSPECM

 +11               DO GETM^PSUTL(60,PSULRDA,"100*^.01;6","PSUSPECM")

 +12               SET DA=0

                   SET PSUFLAG=0

                   FOR 

                       SET DA=$ORDER(PSUSPECM(DA))

                       IF DA'>0

                           QUIT 

                       SET W=PSUSPECM(DA,.01)

                       IF $DATA(PSUFLAG(W))

                           SET PSUFLAG=1

                           QUIT 

 +13               IF 'PSUFLAG

                       QUIT 

 +14      ;  store DrugCode, WrkCode, Lab IEN = Location

 +15               SET PSULOC=$$VAL^PSUTL(60,PSULRDA,5)

                   SET PSULOC=$PIECE(PSULOC,";",2)

 +16      ;S ^XTMP(PSULRSUB,"CODES",X,+Y,PSULRDA)=PSULOC ; Trace Construction

 +17               SET ^XTMP(PSULRSUB,"CODES",X,PSULOC)=$$VAL^PSUTL(60,PSULRDA,.01)_U_PSUSPECM(DA,6)

               End DoDot:1