source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFDE23.m@ 794

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1IBDFDE23 ;ALB/DHH - Select CPT Modifiers during Manual Data Entry ; MAY-18-1999
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**38,37**;APR 24, 1997
3MOD ;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 ;
38OTHER ;--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
45DELMOD ; 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
51ARRAY ; -- 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 ;
59ERR ;Error message
60 W !,X," is not a valid modifier for ",CODE,!
61 Q
62GAFSCOR ;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 ;
79OKPROV(IEN) ; Screen for provider lookup using person class
80 Q ($D(^XUSEC("SD GAF SCORE",IEN)))
81 ;
Note: See TracBrowser for help on using the repository browser.