IBDF4C.m

IBDF4C ;ALB/DHH - CPT MODIFIER SELECTION ;26-MAY-1999

 ;;3.0;AUTOMATED INFO COLLECTION SYS;**38**;APR 24,1997

MOD ;Entry point for selecting or modifying modifiers

 ; -- this is called by the input transform (fileman file: selection)

 ;   

 ;    slctn -- is the ien of selection file and should be cpt code

 ;    $$modp^icptmod  -- screens appropriate modifiers for a cpt code

 ;

 D

 .N DO,CPT,Y,DIC

 .Q:$G(SLCTN)=""

 .S CPT=$P(^IBE(357.3,SLCTN,0),"^")

 .Q:$G(CPT)=""

 .S DIC=81.3,DIC("S")="I ($$MODP^ICPTMOD(CPT,+Y,""I""))>0"

 .S DIC(0)="EM" D ^DIC

 .S (DIX,X)=$P(Y,"^",2)

 .I +Y<1 D

 .. D EN^DDIOL("Invalid CPT Modifier entered for CPT procedure code.")

 Q

 ;

 ;

ADD ;add cpt modifiers to the selection file

 ;

 ; -- this is to be called via IBDF4 AND IBDF4A

 ;

 ; -- check package interface file to see if CPT Modifiers are to be

 ;    asked.

 ;

 Q:$P($G(^IBE(357.6,+$P($G(^IBE(357.2,+IBLIST,0)),U,11),0)),U,21)'=1

 ;

 ; -- use fileman to allow user to add/edit modifiers

 ;    using CPT API to screen out inappropriate modifiers ( this is 

 ;    done via the input transform on the CPT MODIFIERS multiple field

 ;

 N DIE,DA,DR

 S DIE="^IBE(357.3,"

 S DA=SLCTN

 S DR="[IBDF CPT MODIFIER]"

 D ^DIE

 Q

LOOKUP ;response to ?? while entering CPT Modifiers

 ;xecutable help used this from file 357.3 cTP Modifier field

 ;

 N DO,CPT,DIC

 Q:$G(SLCTN)=""

 S CPT=$P(^IBE(357.3,SLCTN,0),"^")

 Q:$G(CPT)=""

 ;S IBDSAV=DIC

 S X="??",DIC=81.3,DIC("S")="I ($$MODP^ICPTMOD(CPT,+Y,""I""))>0"

 S DIC(0)="EMQ" D ^DIC

 Q

IBDF4C    ;ALB/DHH - CPT MODIFIER SELECTION ;26-MAY-1999

 +1       ;;3.0;AUTOMATED INFO COLLECTION SYS;**38**;APR 24,1997

MOD       ;Entry point for selecting or modifying modifiers

 +1       ; -- this is called by the input transform (fileman file: selection)

 +2       ;   

 +3       ;    slctn -- is the ien of selection file and should be cpt code

 +4       ;    $$modp^icptmod  -- screens appropriate modifiers for a cpt code

 +5       ;

 +6        Begin DoDot:1

 +7            NEW DO,CPT,Y,DIC

 +8            IF $GET(SLCTN)=""

                   QUIT 

 +9            SET CPT=$PIECE(^IBE(357.3,SLCTN,0),"^")

 +10           IF $GET(CPT)=""

                   QUIT 

 +11           SET DIC=81.3

               SET DIC("S")="I ($$MODP^ICPTMOD(CPT,+Y,""I""))>0"

 +12           SET DIC(0)="EM"

               DO ^DIC

 +13           SET (DIX,X)=$PIECE(Y,"^",2)

 +14           IF +Y<1

                   Begin DoDot:2

 +15                   DO EN^DDIOL("Invalid CPT Modifier entered for CPT procedure code.")

                   End DoDot:2

           End DoDot:1

 +16       QUIT 

 +17      ;

 +18      ;

ADD       ;add cpt modifiers to the selection file

 +1       ;

 +2       ; -- this is to be called via IBDF4 AND IBDF4A

 +3       ;

 +4       ; -- check package interface file to see if CPT Modifiers are to be

 +5       ;    asked.

 +6       ;

 +7        IF $PIECE($GET(^IBE(357.6,+$PIECE($GET(^IBE(357.2,+IBLIST,0)),U,11),0)),U,21)'=1

               QUIT 

 +8       ;

 +9       ; -- use fileman to allow user to add/edit modifiers

 +10      ;    using CPT API to screen out inappropriate modifiers ( this is 

 +11      ;    done via the input transform on the CPT MODIFIERS multiple field

 +12      ;

 +13       NEW DIE,DA,DR

 +14       SET DIE="^IBE(357.3,"

 +15       SET DA=SLCTN

 +16       SET DR="[IBDF CPT MODIFIER]"

 +17       DO ^DIE

 +18       QUIT 

LOOKUP    ;response to ?? while entering CPT Modifiers

 +1       ;xecutable help used this from file 357.3 cTP Modifier field

 +2       ;

 +3        NEW DO,CPT,DIC

 +4        IF $GET(SLCTN)=""

               QUIT 

 +5        SET CPT=$PIECE(^IBE(357.3,SLCTN,0),"^")

 +6        IF $GET(CPT)=""

               QUIT 

 +7       ;S IBDSAV=DIC

 +8        SET X="??"

           SET DIC=81.3

           SET DIC("S")="I ($$MODP^ICPTMOD(CPT,+Y,""I""))>0"

 +9        SET DIC(0)="EMQ"

           DO ^DIC

 +10       QUIT