| [613] | 1 | IBDFDE23 ;ALB/DHH - Select CPT Modifiers during Manual Data Entry ; MAY-18-1999
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;**38,37**;APR 24, 1997
|
|---|
| 3 | MOD ;Entry point for selecting or modifying modifiers
|
|---|
| 4 | ;
|
|---|
| 5 | ; -- called by IBDFDE21
|
|---|
| 6 | ;
|
|---|
| 7 | N CODE,I,X,SEL,MOD,Y,CNT,MODLST
|
|---|
| 8 | ;
|
|---|
| 9 | ;-- result is definition is noted in ^ibdfde2
|
|---|
| 10 | ; result:= pckg interface^code to send^text to send...
|
|---|
| 11 | ;
|
|---|
| 12 | S CODE=$P(RESULT(IBDX),"^",2)
|
|---|
| 13 | ;
|
|---|
| 14 | ; --ans = list number, cpt, or cpt-mod,mod (raw data user enters)
|
|---|
| 15 | ; if ans contains "-" then seperate and validate each cpt modifier pair
|
|---|
| 16 | ; if ans contains "-" ans should = cpt-mod,mod,mod...
|
|---|
| 17 | ; else ask for modifiers
|
|---|
| 18 | ;
|
|---|
| 19 | I ANS["-" D
|
|---|
| 20 | .S MODLST=$P(ANS,"-",2)
|
|---|
| 21 | .F I=1:1 S X=$P(MODLST,",",I) Q:X']"" D
|
|---|
| 22 | ..; --check for appropriate modifiers/cpt matches
|
|---|
| 23 | ..; cpts and modifiers can be input as
|
|---|
| 24 | ..; -- cpt-mod,mod,mod
|
|---|
| 25 | ..; if multiple modifiers were entered with cpt, each cpt-mod pair
|
|---|
| 26 | ..; will be checked by modp^icptmod to see if valid. if not, an
|
|---|
| 27 | ..; error message will be displayed for the invalid code pair
|
|---|
| 28 | ..;
|
|---|
| 29 | .. I $$MODP^ICPTMOD(CODE,X)'>0 D ERR Q
|
|---|
| 30 | .. S SEL("MOD",X)=""
|
|---|
| 31 | ;
|
|---|
| 32 | ; --no matter what method user uses to input data modifiers should
|
|---|
| 33 | ; should be asked for each cpt code
|
|---|
| 34 | ;
|
|---|
| 35 | D OTHER,ARRAY
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | OTHER ;--allow for additional modifiers to be selected
|
|---|
| 39 | N DIC
|
|---|
| 40 | F S DIC=81.3,DIC("S")="I ($$MODP^ICPTMOD(CODE,+Y,""I""))>0",DIC(0)="AEMQ" D ^DIC Q:+Y<1 D
|
|---|
| 41 | . S MOD=$P($G(Y),"^",2)
|
|---|
| 42 | . I $D(SEL("MOD",MOD)) D DELMOD Q:Y=1
|
|---|
| 43 | . S:MOD'="" SEL("MOD",MOD)=""
|
|---|
| 44 | Q
|
|---|
| 45 | DELMOD ; Delete modifier from list if duplicate entry
|
|---|
| 46 | N DIR,DA,DR,DIC
|
|---|
| 47 | W !,"Do you want to remove this modifier as being Associated with this CPT Procedure?"
|
|---|
| 48 | S DIR(0)="Y",DIR("B")="YES" D ^DIR Q:$D(DIRUT)
|
|---|
| 49 | I Y=1 K SEL("MOD",MOD)
|
|---|
| 50 | Q
|
|---|
| 51 | ARRAY ; -- transfer modifier data to result array
|
|---|
| 52 | Q:'$D(SEL)
|
|---|
| 53 | S MOD="",CNT=0 F S MOD=$O(SEL("MOD",MOD)) Q:MOD']"" D
|
|---|
| 54 | . S CNT=CNT+1
|
|---|
| 55 | . S RESULT(IBDX,"MODIFIER",CNT)=MOD
|
|---|
| 56 | S RESULT(IBDX,"MODIFIER",0)=CNT
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | ERR ;Error message
|
|---|
| 60 | W !,X," is not a valid modifier for ",CODE,!
|
|---|
| 61 | Q
|
|---|
| 62 | GAFSCOR ;Enter GAF Score
|
|---|
| 63 | ;GAFCNT is newed in % of IBDFDE,IBDFDE6,IBDFDE7
|
|---|
| 64 | S GAFCNT=$G(GAFCNT)+1
|
|---|
| 65 | I GAFCNT=2 Q
|
|---|
| 66 | I GAFCNT>2 K GAFCNT Q
|
|---|
| 67 | S DIR(0)="N^1:100"
|
|---|
| 68 | S DIR("A")="Enter GAF Score "
|
|---|
| 69 | S DIR("?")="GAF Score is numeric from 1-100."
|
|---|
| 70 | D ^DIR
|
|---|
| 71 | I Y<1 D G GAFSCOR
|
|---|
| 72 | . W "You must enter a GAF Score (1-100)!"
|
|---|
| 73 | . S GAFCNT=$G(GAFCNT)-1
|
|---|
| 74 | S IBDSEL(0)=$G(IBDSEL(0))+1
|
|---|
| 75 | S IBDSEL(IBDSEL(0))=IBDF("PI")_"^"_+Y_"^ ^^^^^GAF SCORE"
|
|---|
| 76 | S $P(PXCA("IBD GAF SCORE",0),"^")=+Y
|
|---|
| 77 | Q
|
|---|
| 78 | ;
|
|---|
| 79 | OKPROV(IEN) ; Screen for provider lookup using person class
|
|---|
| 80 | Q ($D(^XUSEC("SD GAF SCORE",IEN)))
|
|---|
| 81 | ;
|
|---|
