close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFLST.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFLST.m@ 1464

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

initial load of WorldVistAEHR
File size: 5.0 KB
RevLine 
1IBDFLST ;ALM/MAF - Maintenance Utility Invalid Codes List - MAY 17 1995
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**9,38,51**;APR 24, 1997
3 ;
4 ;
5START ; -- Ask what invalid code you want to display CPT/ ICD9/ Visit
6 N IBDFDIS
7 D FULL^VALM1
8 S DIR("B")="CPT",DIR(0)="SBM^C:CPT;I:ICD9;V:VISIT",DIR("A")="Display invalid codes for [C]PT, [I]CD9, [V]ISIT" D ^DIR
9 K DIR I $D(DIRUT)!(Y<0) G QUIT
10 ;W !!,"Display invalid codes for CPT// " D ZSET1^IBDFLST1 S X="" R X:DTIME G QUIT:X="^"!('$T) I X=""!("Cc"[X) S X="1"
11 S X=$S("Ii"[X:2,"Vv"[X:3,1:1)
12 ;I X="?" D ZSET1^IBDFLST1,HELP1^IBDFLST1 G START
13 S IBDFTYP=$E(X) ; D IN^DGHELP W ! I %=-1 D ZSET1^IBDFLST1,HELP1^IBDFLST1 G START
14 S IBDFDIS=$S(IBDFTYP=1:"CPT",IBDFTYP=2:"ICD9",IBDFTYP=3:"VISIT",1:"QUIT")
15 D WAIT^DICD
16 D EN^VALM("IBDF UTIL COMPLETE LIST TEMP")
17 Q
18 ;
19 ;
20HDR ; -- header code
21 S VALMHDR(1)="This screen displays the most current invalid codes for the "_IBDFDIS_" file."
22 Q
23 ;
24 ;
25SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
26 ; S := string
27 ; V := destination
28 ; X := @ col X
29 ; L := # of chars
30 ;
31 Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
32 ;
33 ;
34INIT ; -- Set up list for display
35 N IBDFCODE,IBDFDESC,IBDFIFN,IBDFCAT
36 S (IBDCNT,VALMCNT,IBDCNT1)=0
37 D @(IBDFDIS)
38 Q
39 ;
40 ; -- Gets CPT listing of invalid codes
41CPT D FULL^VALM1 F IBDFIFN=0:0 S IBDFIFN=$O(^ICPT(IBDFIFN)) Q:'IBDFIFN D
42 .;; --change to api cpt ; dhh
43 .;; --note: 7th piece is status 0-inactive 1-active
44 . S IBDFNODE=$$CPT^ICPTCOD(IBDFIFN),IBDFNODE=$G(IBDFNODE)
45 . I $P(IBDFNODE,"^",7)=0 D
46 .. S IBDFCODE=$P(IBDFNODE,"^",2),IBDFDESC=$P(IBDFNODE,"^",3)
47 .. S IBDFCAT=$S($P(IBDFNODE,"^",4)]"":$P(^DIC(81.1,$P(IBDFNODE,"^",4),0),"^",1),1:"UNKNOWN") D ALPHA
48 D LOOP
49 Q
50 ;
51 ; -- Gets ICD9 listing onf invalid codes
52 ; -- Use api for ICD9
53ICD9 ;;F IBDFIFN=0:0 S IBDFIFN=$O(^ICD9(IBDFIFN)) Q:'IBDFIFN S IBDFNODE=$G(^ICD9(IBDFIFN,0)) I $P(IBDFNODE,"^",9)]"" D
54 ;
55 ;Use ICD API to check the status for CSV. No date is passed so the
56 ;default day is DT (today). $P10 = status 0-inactive 1-active
57 F IBDFIFN=0:0 S IBDFIFN=$O(^ICD9(IBDFIFN)) Q:'IBDFIFN S IBDFNODE=$$ICDDX^ICDCODE(IBDFIFN) I '$P(IBDFNODE,U,10) D
58 .S IBDFCODE=$P(IBDFNODE,"^",2),IBDFDESC=$P(IBDFNODE,"^",4),IBDFCAT=$S($P(IBDFNODE,"^",6)]""&($G(^ICM(+$P(IBDFNODE,"^",6),0))]""):$P(^ICM($P(IBDFNODE,"^",6),0),"^",1),1:"UNKNOWN") D ALPHA
59 D LOOP
60 Q
61 ;
62 ;
63VISIT ; -- Gets visit code listing of invalid codes
64 N IEN
65 F IBDFVST=0:0 S IBDFVST=$O(^IBE(357.69,"B",IBDFVST)) Q:'IBDFVST D
66 . S IEN=$O(^IBE(357.69,"B",IBDFVST,0))
67 . Q:'IEN
68 . S IBDFNODE=$$CPT^ICPTCOD(IBDFVST)
69 . Q:$P(IBDFNODE,U,7)=1 ;(CSV) status 0-inactive 1-active
70 . ;;Q:+IBDFNODE=-1
71 . S IBDFIFN=+IBDFNODE
72 . S IBDFCODE=$P(IBDFNODE,"^",2)
73 . S IBDFDESC=$P(IBDFNODE,"^",3)
74 . S IBDFCAT=$S($P(IBDFNODE,"^",4)]"":$P(^DIC(81.1,$P(IBDFNODE,"^",4),0),"^",1),1:"UNKNOWN")
75 . D ALPHA
76 D LOOP
77 Q
78 ;
79 ;
80LOOP ; -- Loop thru global ^TMP("ALPHA",$J) alphabetic by category
81 S IBDFCAT=0
82 F IBDCAT=0:0 S IBDFCAT=$O(^TMP("ALPHA",$J,IBDFCAT)) Q:IBDFCAT']"" F IBDFIFN=0:0 S IBDFIFN=$O(^TMP("ALPHA",$J,IBDFCAT,IBDFIFN)) Q:'IBDFIFN S IBDFNODE=$G(^TMP("ALPHA",$J,IBDFCAT,IBDFIFN)) D
83 .S IBDFIFN=$P(IBDFNODE,"^",1)
84 .S IBDFCODE=$P(IBDFNODE,"^",2)
85 .S IBDFCAT=$P(IBDFNODE,"^",3)
86 .S IBDFDESC=$P(IBDFNODE,"^",4)
87 .D:'$D(IBDFC(IBDFCAT)) HEADER^IBDFLST1 D SET
88 Q
89 ;
90 ;
91SET ; -- Set up list array
92 S IBDCNT1=IBDCNT1+1
93 S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
94 S X=""
95 S IBDFVAL=$J(IBDCNT1_")",5)
96 S X=$$SETSTR(IBDFVAL,X,1,5)
97 S IBDFVAL=IBDFCODE
98 S X=$$SETSTR(IBDFVAL,X,7,8)
99 S IBDFVAL=IBDFDESC
100 S X=$$SETSTR(IBDFVAL,X,17,20)
101 S IBDFVAL=IBDFCAT
102 S X=$$SETSTR(IBDFVAL,X,39,20)
103 ;
104 ;
105TMP ; -- Set up Array
106 S ^TMP("CODE",$J,IBDCNT,0)=$$LOWER^VALM1(X),^TMP("CODE",$J,"IDX",VALMCNT,IBDCNT1)=""
107 S ^TMP("CODEIDX",$J,IBDCNT1)=VALMCNT_"^"_IBDFIFN_"^"_IBDFCODE_"^"_IBDFCAT_"^"_IBDFDESC
108 Q
109 ;
110 ;
111ALPHA ; - Alphabetize by category
112 S ^TMP("ALPHA",$J,IBDFCAT,IBDFIFN)=IBDFIFN_"^"_IBDFCODE_"^"_IBDFCAT_"^"_IBDFDESC
113 Q
114 ;
115 ;
116QUIT ; -- Kill variables and reset to last display if no change has been taken place.
117 ;
118 ;
119EXIT K ^TMP("CODE",$J),^TMP("CODEIDX",$J),^TMP("ALPHA",$J)
120 K IBDFC,IBDFTYP,IBDFCNT1,IBDCAT
121 Q
122 ;
123 ;
124JUMP ; -- Jump action to display a specific category on the screen.
125 D FULL^VALM1
126 I $D(XQORNOD(0)),$P(XQORNOD(0),"^",4)]"" S X=$P(XQORNOD(0),"^",4) S X=$P(X,"=",2) I X]"" D:X?1.6N JSEL S DIC=$S(IBDFDIS="ICD9":"^ICM(",1:"^DIC(81.1,"),DIC(0)="QEZ" D ^DIC K DIC G:Y<0 JMP S Y=+Y D JUMP1 Q
127JMP S DIC=$S(IBDFDIS="ICD9":"^ICM(",1:"^DIC(81.1,"),DIC(0)="AEMN",DIC("A")="Select "_$S(IBDFDIS="ICD9":"ICD9",1:"CPT")_" category you wish to move to: "
128 D ^DIC K DIC
129 I X["^" S VALMBG=1,VALMBCK="R" Q
130 ;
131 ;
132JUMP1 I Y<0 G JUMP
133 N IBDFCAT
134 S IBDFCAT=$S(IBDFDIS="ICD9":$P(^ICM(+Y,0),"^",1),1:$P(^DIC(81.1,+Y,0),"^",1))
135 I '$D(IBDFC(IBDFCAT)) W !!,"There is no data listed for this Clinic Group" G JMP
136 S VALMBG=+IBDFC(IBDFCAT) S VALMBCK="R" Q
137 Q
138 ;
139 ;
140JSEL ; -- Convert number selected to name
141 S IBDVALM=X I $D(^TMP("CGIDX",$J,IBDVALM)) S X=$P(^TMP("CGIDX",$J,IBDVALM),"^",2),X=$P(^IBD(357.99,X,0),"^",1)
142 Q
143HLP ; -- help code
144 S X="?" D DISP^XQORM1 W !!
145 Q
146 ;
Note: See TracBrowser for help on using the repository browser.