source: WorldVistAEHR/trunk/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTCR.m@ 619

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1ICPTCR ;ALB/ABR - MUMPS CROSS REFERENCE ROUTINE ; 3/10/97
2 ;;6.0;CPT/HCPCS;;May 19, 1997;Build 1
3 ;
4 ; VARIABLES
5 ; ICPTA = Begin Range
6 ; ICPTX = End Range
7 ;
8CATEG ; For CATEGORY x-refs (file 81.1, fields 4-BEGIN CPT RANGE, and
9 ; 5-END CPT RANGE)
10 ; CAT = category type; used to determine x-ref "M" or "R"
11 ; where "M" is used only for Major categories, and
12 ; "R" is used for all others (not major) categories.
13 ;
14CSET(DA,ICPTX,CAT) ; category range x-ref on END range
15 N ICPTA
16 S ICPTA=$P(^DIC(81.1,DA,0),U,4),ICPTA=$$NUM^ICPTAPIU(ICPTA) ; begin cpt range
17 S ICPTX=$$NUM^ICPTAPIU(ICPTX)
18 D CXSET
19 Q
20 ;
21CKIL(DA,CAT) ; x-ref kill on END range
22 N ICPTA
23 S ICPTA=$P(^DIC(81.1,DA,0),U,4),ICPTA=$$NUM^ICPTAPIU(ICPTA)
24 I ICPTA<0 Q
25 D CXKIL
26 Q
27 ;
28 ;
29CBSET(DA,ICPTA) ; x-ref on begin range for categories
30 ;
31 N ICPTX,CAT
32 D CVAR
33 S ICPTA=$$NUM^ICPTAPIU(ICPTA),ICPTX=$$NUM^ICPTAPIU(ICPTX)
34 D CXSET
35 Q
36 ;
37CBKIL(DA,ICPTA) ; x-ref kill on begin range for categories
38 N ICPTX,CAT
39 D CVAR
40 S ICPTA=$$NUM^ICPTAPIU(ICPTA)
41 D CXKIL
42 Q
43 ;
44CVAR ; set begin range x-ref variables.
45 ; ICPTX = end range
46 N ICPTSTR
47 S ICPTSTR=^DIC(81.1,DA,0),CAT=$S($P(ICPTSTR,U,2)="m":"M",1:"R"),ICPTX=$P(ICPTSTR,U,5)
48 Q
49 ;
50CXSET ; set of category x-ref
51 S ^DIC(81.1,CAT,ICPTA,DA)=ICPTX
52 Q
53 ;
54CXKIL ; kill of category x-ref
55 K ^DIC(81.1,CAT,ICPTA,DA)
56 Q
57 ;
58MODIFIER ; Mod x-refs
59 ; ICPTA = begin range
60 ; ICPTX = end range
61 ; M = If $G(M), do whole file x-ref,
62 ; else, just x-ref within multiple
63 ;
64MSET(DA,ICPTX,M) ; x-ref on end range
65 N ICPTA
66 S ICPTA=$P(^DIC(81.3,DA(1),10,DA,0),U),ICPTA=$$NUM^ICPTAPIU(ICPTA)
67 S ICPTX=$$NUM^ICPTAPIU(ICPTX)
68 I $G(M) D MXMSET Q
69 D MXSET
70 Q
71 ;
72MKIL(DA,ICPTX,M) ; x-ref kill on end range
73 N ICPTA
74 S ICPTA=$P(^DIC(81.3,DA(1),10,DA,0),U),ICPTA=$$NUM^ICPTAPIU(ICPTA)
75 S ICPTX=$$NUM^ICPTAPIU(ICPTX)
76 I $G(M) D MXMKIL Q
77 D MXKIL
78 Q
79 ;
80MBSET(DA,ICPTA,M) ; modifier begin range x-ref
81 N ICPTX
82 S ICPTX=$P(^DIC(81.3,DA(1),10,DA,0),U,2),ICPTX=$$NUM^ICPTAPIU(ICPTX)
83 S ICPTA=$$NUM^ICPTAPIU(ICPTA)
84 I $G(M) D MXMSET Q
85 D MXSET
86 Q
87 ;
88MBKIL(DA,ICPTA,M) ; modifier begin range x-ref kill
89 N ICPTX
90 S ICPTX=$P(^DIC(81.3,DA(1),10,DA,0),U,2),ICPTX=$$NUM^ICPTAPIU(ICPTX)
91 S ICPTA=$$NUM^ICPTAPIU(ICPTA)
92 I $G(M) D MXMKIL Q
93 D MXKIL
94 Q
95 ;
96MXSET ; set modifier x-ref
97 S ^DIC(81.3,DA(1),"M",ICPTA)=ICPTX
98 Q
99 ;
100MXKIL ; kill modifier x-ref
101 K ^DIC(81.3,DA(1),"M",ICPTA)
102 Q
103 ;
104MXMSET ; set full file x-ref on range
105 S ^DIC(81.3,"M",ICPTA,ICPTX,DA(1))=DA
106 Q
107MXMKIL ; kill full file x-ref on range
108 K ^DIC(81.3,"M",ICPTA,ICPTX,DA(1))
109 Q
Note: See TracBrowser for help on using the repository browser.