BMCPXCHK.m

BMCPXCHK ; IHS/PHXAO/TMJ - CHECK CPT CAT/PX AT CLOSE TIME ;

 ;;4.0;REFERRED CARE INFO SYSTEM;**3**;JAN 09, 2006;Build 101

 ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES

 ;

 ; This routine checks to insure the cpt category and the cpt

 ; procedures are logically consistent.

 ;

 ; BMCRIEN=referral ien

 ;

START ;

 NEW BMCCAT,BMCCIEN,BMCOK,BMCPX,BMCSIG,BMCTBL,BMCTIEN,BMCX,BMCY,X

 D CHECK ;                         check consistency

 Q:BMCOK  ;                        quit if ok

 D EN3^BMCBULL ;                   send bulletin

 Q

 ;

CHECK ; CHECK CATEGORY/CODES

 S BMCOK=1

 S BMCCAT=$P(^BMCREF(BMCRIEN,0),U,13)

 Q:'BMCCAT  ;                      no category to check

 S BMCTIEN=$P(^BMCTSVC(BMCCAT,0),U,2)

 Q:'BMCTIEN  ;                     no taxonomy to check

 Q:'$O(^BMCPX("AD",BMCRIEN))  ;    no pxs to check

 ; table all pxs for this referral

 S BMCY=0

 ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES

 ;F  S BMCY=$O(^BMCPX("AD",BMCRIEN,BMCY)) Q:'BMCY  S BMCCIEN=$P(^BMCPX(BMCY,0),U),BMCPX=$P(^ICPT(BMCCIEN,0),U),BMCTBL(BMCPX)=BMCCIEN

 F  S BMCY=$O(^BMCPX("AD",BMCRIEN,BMCY)) Q:'BMCY  S BMCCIEN=$P(^BMCPX(BMCY,0),U),BMCPX=$P($$CPT^ICPTCOD(BMCCIEN,0),U,2),BMCTBL(BMCPX)=BMCCIEN

 D CHECK2 ;                        see if significant px in category

 Q:BMCSIG  ;                       ok if significant px in category

 ; see if significant px in any other category

 S BMCY=0

 F  S BMCY=$O(^BMCTSVC(BMCY)) Q:'BMCY  D  Q:BMCSIG

 . Q:BMCY=BMCCAT  ;                quit if original category

 . S BMCTIEN=$P(^BMCTSVC(BMCY,0),U,2)

 . Q:'BMCTIEN  ;                   quit if no taxonomy

 . D CHECK2

 . Q

 Q:'BMCSIG  ;                      ok if no significant px at all

 S BMCOK=0

 Q

 ;

CHECK2 ; SEE IF SIGNIFICANT PX IN CATEGORY

 S BMCSIG=0,BMCPX=""

 F  S BMCPX=$O(BMCTBL(BMCPX)) Q:BMCPX=""  D  Q:BMCSIG

 . S BMCCIEN=BMCTBL(BMCPX)

 . S BMCSIG=$$TXC^ATXTXCHK(BMCCIEN,BMCTIEN)

 . Q

 Q

 ;

 ;

LOGIC ;

 ; ok if no category

 ; ok if no taxonomy

 ; ok if no procedures at all

 ; ok if significant procedure in specified category

 ; ok if no significant procedure in any category

 ; if significant procedure in some other category send bulletin

 ;

 ; cpt category present              |NYYYYY

 ; significant taxonomy present      | NYYYY

 ; procedures present                |  NYYY

 ; significant procedure in category |   YNN

 ; any significant procedures        |    NY

 ;

 ; send bulletin                     |     X

 ; exit                              |XXXXXX

BMCPXCHK  ; IHS/PHXAO/TMJ - CHECK CPT CAT/PX AT CLOSE TIME ;

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;**3**;JAN 09, 2006;Build 101

 +2       ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES

 +3       ;

 +4       ; This routine checks to insure the cpt category and the cpt

 +5       ; procedures are logically consistent.

 +6       ;

 +7       ; BMCRIEN=referral ien

 +8       ;

START     ;

 +1        NEW BMCCAT,BMCCIEN,BMCOK,BMCPX,BMCSIG,BMCTBL,BMCTIEN,BMCX,BMCY,X

 +2       ;                         check consistency

           DO CHECK

 +3       ;                        quit if ok

           IF BMCOK

               QUIT 

 +4       ;                   send bulletin

           DO EN3^BMCBULL

 +5        QUIT 

 +6       ;

CHECK     ; CHECK CATEGORY/CODES

 +1        SET BMCOK=1

 +2        SET BMCCAT=$PIECE(^BMCREF(BMCRIEN,0),U,13)

 +3       ;                      no category to check

           IF 'BMCCAT

               QUIT 

 +4        SET BMCTIEN=$PIECE(^BMCTSVC(BMCCAT,0),U,2)

 +5       ;                     no taxonomy to check

           IF 'BMCTIEN

               QUIT 

 +6       ;    no pxs to check

           IF '$ORDER(^BMCPX("AD",BMCRIEN))

               QUIT 

 +7       ; table all pxs for this referral

 +8        SET BMCY=0

 +9       ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES

 +10      ;F  S BMCY=$O(^BMCPX("AD",BMCRIEN,BMCY)) Q:'BMCY  S BMCCIEN=$P(^BMCPX(BMCY,0),U),BMCPX=$P(^ICPT(BMCCIEN,0),U),BMCTBL(BMCPX)=BMCCIEN

 +11       FOR 

               SET BMCY=$ORDER(^BMCPX("AD",BMCRIEN,BMCY))

               IF 'BMCY

                   QUIT 

               SET BMCCIEN=$PIECE(^BMCPX(BMCY,0),U)

               SET BMCPX=$PIECE($$CPT^ICPTCOD(BMCCIEN,0),U,2)

               SET BMCTBL(BMCPX)=BMCCIEN

 +12      ;                        see if significant px in category

           DO CHECK2

 +13      ;                       ok if significant px in category

           IF BMCSIG

               QUIT 

 +14      ; see if significant px in any other category

 +15       SET BMCY=0

 +16       FOR 

               SET BMCY=$ORDER(^BMCTSVC(BMCY))

               IF 'BMCY

                   QUIT 

               Begin DoDot:1

 +17      ;                quit if original category

                   IF BMCY=BMCCAT

                       QUIT 

 +18               SET BMCTIEN=$PIECE(^BMCTSVC(BMCY,0),U,2)

 +19      ;                   quit if no taxonomy

                   IF 'BMCTIEN

                       QUIT 

 +20               DO CHECK2

 +21               QUIT 

               End DoDot:1

               IF BMCSIG

                   QUIT 

 +22      ;                      ok if no significant px at all

           IF 'BMCSIG

               QUIT 

 +23       SET BMCOK=0

 +24       QUIT 

 +25      ;

CHECK2    ; SEE IF SIGNIFICANT PX IN CATEGORY

 +1        SET BMCSIG=0

           SET BMCPX=""

 +2        FOR 

               SET BMCPX=$ORDER(BMCTBL(BMCPX))

               IF BMCPX=""

                   QUIT 

               Begin DoDot:1

 +3                SET BMCCIEN=BMCTBL(BMCPX)

 +4                SET BMCSIG=$$TXC^ATXTXCHK(BMCCIEN,BMCTIEN)

 +5                QUIT 

               End DoDot:1

               IF BMCSIG

                   QUIT 

 +6        QUIT 

 +7       ;

 +8       ;

LOGIC     ;

 +1       ; ok if no category

 +2       ; ok if no taxonomy

 +3       ; ok if no procedures at all

 +4       ; ok if significant procedure in specified category

 +5       ; ok if no significant procedure in any category

 +6       ; if significant procedure in some other category send bulletin

 +7       ;

 +8       ; cpt category present              |NYYYYY

 +9       ; significant taxonomy present      | NYYYY

 +10      ; procedures present                |  NYYY

 +11      ; significant procedure in category |   YNN

 +12      ; any significant procedures        |    NY

 +13      ;

 +14      ; send bulletin                     |     X

 +15      ; exit                              |XXXXXX