source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMBXTL.m@ 792

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

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1PXRMBXTL ; SLC/PKR - Build expanded taxonomies. ;08/10/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;====================================================
5CHECK(TAXIEN,KI) ;Check for expanded taxonomy, build it if it does not
6 ;exist.
7 N TEMP
8 S TEMP=$G(^PXD(811.3,TAXIEN,0))
9 I TEMP="" D EXPAND(TAXIEN,KI)
10 Q
11 ;
12 ;====================================================
13DELEXTL(TAXIEN) ;Delete an expanded taxonomy.
14 I '$$LOCKXTL(TAXIEN) Q
15 N DA,DIK
16 S DIK="^PXD(811.3,"
17 S DA=TAXIEN
18 D ^DIK
19 D ULOCKXTL(TAXIEN)
20 Q
21 ;
22 ;====================================================
23EXPAND(TAXIEN,KI) ;Build an expanded taxonomy. If KI is defined then
24 ;entry KI is being deleted so skip it. KI is checked because this
25 ;can be called by cross-references in 811.2.
26 I '$$LOCKXTL(TAXIEN) Q
27 N CPTDATE,DATEBLT,HIGH,ICD0DATE,ICD9DATE,IND,LOW
28 N NICD0,NICD9,NICPT,NRCPT,TEMP,X,X1,X2
29 K ^PXD(811.3,TAXIEN)
30 S DATEBLT=$$NOW^XLFDT
31 S $P(^PXD(811.3,TAXIEN,0),U,1)=TAXIEN
32 S $P(^PXD(811.3,TAXIEN,0),U,2)=DATEBLT
33 ;
34 S (IND,NICD0)=0
35 F S IND=+$O(^PXD(811.2,TAXIEN,80.1,IND)) Q:IND=0 D
36 . I KI=IND Q
37 . S TEMP=^PXD(811.2,TAXIEN,80.1,IND,0)
38 . S LOW=$P(TEMP,U,1)
39 . S HIGH=$P(TEMP,U,2)
40 . I HIGH="" S HIGH=LOW
41 . D ICD0(TAXIEN,LOW,HIGH,.NICD0)
42 S ICD0DATE=$$GET1^DID(80.1,"","","PACKAGE REVISION DATA")
43 S ICD0DATE=$P(ICD0DATE,U,2)
44 S $P(^PXD(811.3,TAXIEN,0),U,3,4)=NICD0_U_ICD0DATE
45 ;
46 S (IND,NICD9)=0
47 F S IND=+$O(^PXD(811.2,TAXIEN,80,IND)) Q:IND=0 D
48 . I KI=IND Q
49 . S TEMP=^PXD(811.2,TAXIEN,80,IND,0)
50 . S LOW=$P(TEMP,U,1)
51 . S HIGH=$P(TEMP,U,2)
52 . I HIGH="" S HIGH=LOW
53 . D ICD9(TAXIEN,LOW,HIGH,.NICD9)
54 S ICD9DATE=$$GET1^DID(80,"","","PACKAGE REVISION DATA")
55 S ICD9DATE=$P(ICD9DATE,U,2)
56 S $P(^PXD(811.3,TAXIEN,0),U,5,6)=NICD9_U_ICD9DATE
57 ;
58 S (IND,NICPT,NRCPT)=0
59 F S IND=+$O(^PXD(811.2,TAXIEN,81,IND)) Q:IND=0 D
60 . I KI=IND Q
61 . S TEMP=^PXD(811.2,TAXIEN,81,IND,0)
62 . S LOW=$P(TEMP,U,1)
63 . S HIGH=$P(TEMP,U,2)
64 . I HIGH="" S HIGH=LOW
65 . D ICPT(TAXIEN,LOW,HIGH,.NICPT,.NRCPT)
66 S CPTDATE=$$GET1^DID(81,"","","PACKAGE REVISION DATA")
67 S CPTDATE=$P(CPTDATE,U,2)
68 S $P(^PXD(811.3,TAXIEN,0),U,7,9)=NICPT_U_CPTDATE_U_NRCPT
69 ;
70 ;Create the patient data source.
71 S (X1,X2)="TAX"
72 S X=$P(^PXD(811.2,TAXIEN,0),U,4)
73 D KPDS^PXRMPDS(X,X1,X2,TAXIEN)
74 D SPDS^PXRMPDS(X,X1,X2,TAXIEN)
75 ;
76 D ULOCKXTL(TAXIEN)
77 Q
78 ;
79 ;====================================================
80ICD0(TAXIEN,LOW,HIGH,NICD0) ;Build the list of internal entries for ICD0
81 ;(File 80.1). Use of ICDAPIU: DBIA #3991
82 N CODE,IEN,TEMP
83 S CODE=LOW
84 F Q:(CODE]HIGH)!(CODE="") D
85 . S TEMP=$$STATCHK^ICDAPIU(CODE,"")
86 . S IEN=$P(TEMP,U,2)
87 . I IEN'=-1,'$D(^PXD(811.3,TAXIEN,80.1,"ICD0P",IEN)) D
88 .. S NICD0=NICD0+1
89 .. S ^PXD(811.3,TAXIEN,80.1,NICD0,0)=IEN
90 .. S ^PXD(811.3,TAXIEN,80.1,"ICD0P",IEN,NICD0,0)=""
91 . S CODE=$$NEXT^ICDAPIU(CODE)
92 Q
93 ;
94 ;====================================================
95ICD9(TAXIEN,LOW,HIGH,NICD9) ;Build the list of internal entries for ICD9
96 ;(File 80). Use of ICDAPIU: DBIA #3991
97 N CODE,IEN,TEMP
98 S CODE=LOW
99 F Q:(CODE]HIGH)!(CODE="") D
100 . S TEMP=$$STATCHK^ICDAPIU(CODE,"")
101 . S IEN=$P(TEMP,U,2)
102 . I IEN'=-1,'$D(^PXD(811.3,TAXIEN,80,"ICD9P",IEN)) D
103 .. S NICD9=NICD9+1
104 .. S ^PXD(811.3,TAXIEN,80,NICD9,0)=IEN
105 .. S ^PXD(811.3,TAXIEN,80,"ICD9P",IEN,NICD9,0)=""
106 . S CODE=$$NEXT^ICDAPIU(CODE)
107 Q
108 ;
109 ;====================================================
110ICPT(TAXIEN,LOW,HIGH,NICPT,NRCPT) ;Build the list of internal entries
111 ;for ICPT (File 81). Use of ICDAPIU: DBIA #3991
112 N CODE,IEN,RADIEN,TEMP
113 S CODE=LOW
114 F Q:(CODE]HIGH)!(CODE="") D
115 . S TEMP=$$STATCHK^ICPTAPIU(CODE,"")
116 . S IEN=$P(TEMP,U,2)
117 . I IEN'=-1,'$D(^PXD(811.3,TAXIEN,81,"ICPTP",IEN)) D
118 .. S NICPT=NICPT+1
119 .. S ^PXD(811.3,TAXIEN,81,NICPT,0)=IEN
120 .. S ^PXD(811.3,TAXIEN,81,"ICPTP",IEN,NICPT,0)=""
121 ..;Determine if this is a radiology procedure.
122 ..;DBIA #586.
123 .. S RADIEN=+$O(^RAMIS(71,"D",IEN,""))
124 .. I RADIEN>0 D
125 ... S NRCPT=NRCPT+1
126 ... S ^PXD(811.3,TAXIEN,71,NRCPT,0)=IEN_U_RADIEN
127 ... S ^PXD(811.3,TAXIEN,71,"RCPTP",RADIEN,NRCPT,0)=IEN
128 . S CODE=$$NEXT^ICPTAPIU(CODE)
129 Q
130 ;
131 ;====================================================
132LOCKXTL(TAXIEN) ;Lock the expanded taxonomy entry. This may be called during
133 ;reminder evalution in which case PXRMXTLK will be defined or during
134 ;a taxonomy edit in which case PXRMXTLK will be undefined.
135 N IND,LC,LOCK
136 I $D(PXRMXTLK) S LC=3
137 E S LC=2
138 S LOCK=0
139 F IND=1:1:LC Q:LOCK D
140 . L +^PXD(811.3,TAXIEN):1
141 . S LOCK=$T
142 ;If we can't a get a lock take appropriate action.
143 I 'LOCK D
144 . I $D(PXRMXTLK) S PXRMXTLK=TAXIEN
145 . E D
146 .. N TEXT
147 .. S TEXT="Could not get lock for expanded taxonomy "_TAXIEN_", try again later."
148 .. D EN^DDIOL(TEXT)
149 Q LOCK
150 ;
151 ;====================================================
152SELEXP ;Entry point for the option selected taxonomy expansion.
153 N TAXIEN
154 S TAXIEN=+$$SELECT^PXRMINQ("^PXD(811.2,","Select a taxonomy to expand: ")
155 I TAXIEN=-1 Q
156 D EXPAND(TAXIEN,"")
157 Q
158 ;
159 ;====================================================
160ULOCKXTL(TAXIEN) ;Unlock the expanded taxonomy.
161 L -^PXD(811.3,TAXIEN)
162 Q
163 ;
Note: See TracBrowser for help on using the repository browser.