IBDFDE23.m

IBDFDE23 ;ALB/DHH - Select CPT Modifiers during Manual Data Entry ; MAY-18-1999

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

MOD ;Entry point for selecting or modifying modifiers

 ;

 ;  -- called by IBDFDE21

 ;

 N CODE,I,X,SEL,MOD,Y,CNT,MODLST

 ;

 ;-- result is definition is noted in ^ibdfde2

 ;   result:= pckg interface^code to send^text to send...

 ;

 S CODE=$P(RESULT(IBDX),"^",2)

 ;

 ; --ans = list number, cpt, or cpt-mod,mod (raw data user enters)

 ; if ans contains "-" then seperate and validate each cpt modifier pair

 ; if ans contains "-" ans should = cpt-mod,mod,mod...

 ; else  ask for modifiers 

 ; 

 I ANS["-" D

 .S MODLST=$P(ANS,"-",2)

 .F I=1:1 S X=$P(MODLST,",",I) Q:X']""  D

 ..; --check for appropriate modifiers/cpt matches

 ..;   cpts and modifiers can be input as 

 ..;      -- cpt-mod,mod,mod

 ..;   if multiple modifiers were entered with cpt, each cpt-mod pair

 ..;   will be checked by modp^icptmod to see if valid.  if not, an

 ..;   error message will be displayed for the invalid code pair

 ..;

 .. I $$MODP^ICPTMOD(CODE,X)'>0 D ERR Q

 .. S SEL("MOD",X)=""

 ;

 ;  --no matter what method user uses to input data modifiers should

 ;    should be asked for each cpt code

 ;

 D OTHER,ARRAY

 Q

 ;

OTHER ;--allow for additional modifiers to be selected

 N DIC

 F  S DIC=81.3,DIC("S")="I ($$MODP^ICPTMOD(CODE,+Y,""I""))>0",DIC(0)="AEMQ" D ^DIC Q:+Y<1  D

 . S MOD=$P($G(Y),"^",2)

 . I $D(SEL("MOD",MOD)) D DELMOD Q:Y=1

 . S:MOD'="" SEL("MOD",MOD)=""

 Q

DELMOD ; Delete modifier from list if duplicate entry

 N DIR,DA,DR,DIC

 W !,"Do you want to remove this modifier as being Associated with this CPT Procedure?"

 S DIR(0)="Y",DIR("B")="YES" D ^DIR Q:$D(DIRUT)

 I Y=1 K SEL("MOD",MOD)

 Q

ARRAY ; -- transfer modifier data to result array

 Q:'$D(SEL)

 S MOD="",CNT=0 F  S MOD=$O(SEL("MOD",MOD)) Q:MOD']""  D

 . S CNT=CNT+1

 . S RESULT(IBDX,"MODIFIER",CNT)=MOD

 S RESULT(IBDX,"MODIFIER",0)=CNT

 Q

 ;

ERR ;Error message

 W !,X," is not a valid modifier for ",CODE,!

 Q

IBDFDE23  ;ALB/DHH - Select CPT Modifiers during Manual Data Entry ; MAY-18-1999

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

MOD       ;Entry point for selecting or modifying modifiers

 +1       ;

 +2       ;  -- called by IBDFDE21

 +3       ;

 +4        NEW CODE,I,X,SEL,MOD,Y,CNT,MODLST

 +5       ;

 +6       ;-- result is definition is noted in ^ibdfde2

 +7       ;   result:= pckg interface^code to send^text to send...

 +8       ;

 +9        SET CODE=$PIECE(RESULT(IBDX),"^",2)

 +10      ;

 +11      ; --ans = list number, cpt, or cpt-mod,mod (raw data user enters)

 +12      ; if ans contains "-" then seperate and validate each cpt modifier pair

 +13      ; if ans contains "-" ans should = cpt-mod,mod,mod...

 +14      ; else  ask for modifiers 

 +15      ; 

 +16       IF ANS["-"

               Begin DoDot:1

 +17               SET MODLST=$PIECE(ANS,"-",2)

 +18               FOR I=1:1

                       SET X=$PIECE(MODLST,",",I)

                       IF X']""

                           QUIT 

                       Begin DoDot:2

 +19      ; --check for appropriate modifiers/cpt matches

 +20      ;   cpts and modifiers can be input as 

 +21      ;      -- cpt-mod,mod,mod

 +22      ;   if multiple modifiers were entered with cpt, each cpt-mod pair

 +23      ;   will be checked by modp^icptmod to see if valid.  if not, an

 +24      ;   error message will be displayed for the invalid code pair

 +25      ;

 +26                       IF $$MODP^ICPTMOD(CODE,X)'>0

                               DO ERR

                               QUIT 

 +27                       SET SEL("MOD",X)=""

                       End DoDot:2

               End DoDot:1

 +28      ;

 +29      ;  --no matter what method user uses to input data modifiers should

 +30      ;    should be asked for each cpt code

 +31      ;

 +32       DO OTHER

           DO ARRAY

 +33       QUIT 

 +34      ;

OTHER     ;--allow for additional modifiers to be selected

 +1        NEW DIC

 +2        FOR 

               SET DIC=81.3

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

               SET DIC(0)="AEMQ"

               DO ^DIC

               IF +Y<1

                   QUIT 

               Begin DoDot:1

 +3                SET MOD=$PIECE($GET(Y),"^",2)

 +4                IF $DATA(SEL("MOD",MOD))

                       DO DELMOD

                       IF Y=1

                           QUIT 

 +5                IF MOD'=""

                       SET SEL("MOD",MOD)=""

               End DoDot:1

 +6        QUIT 

DELMOD    ; Delete modifier from list if duplicate entry

 +1        NEW DIR,DA,DR,DIC

 +2        WRITE !,"Do you want to remove this modifier as being Associated with this CPT Procedure?"

 +3        SET DIR(0)="Y"

           SET DIR("B")="YES"

           DO ^DIR

           IF $DATA(DIRUT)

               QUIT 

 +4        IF Y=1

               KILL SEL("MOD",MOD)

 +5        QUIT 

ARRAY     ; -- transfer modifier data to result array

 +1        IF '$DATA(SEL)

               QUIT 

 +2        SET MOD=""

           SET CNT=0

           FOR 

               SET MOD=$ORDER(SEL("MOD",MOD))

               IF MOD']""

                   QUIT 

               Begin DoDot:1

 +3                SET CNT=CNT+1

 +4                SET RESULT(IBDX,"MODIFIER",CNT)=MOD

               End DoDot:1

 +5        SET RESULT(IBDX,"MODIFIER",0)=CNT

 +6        QUIT 

 +7       ;

ERR       ;Error message

 +1        WRITE !,X," is not a valid modifier for ",CODE,!

 +2        QUIT