source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMCSSC.m@ 1654

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1PXRMCSSC ; SLC/PKR - Routines for taxonomy code set update. ;04/10/2003
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;============================================================
5SELCODE(FILENUM,TAXIEN,LC,TAXMSG) ;Create the message for selectable
6 ;codes. Check for codes that are currently inactive or will be
7 ;inactive within the next 180 days.
8 N CODE,CPTCLST,CPTFLST,DT6M,ICD9CLST,ICD9FLST,IEN,ILC,MSGARR,NODE,STATUS
9 ;Go through the selectable codes making an ordered list.
10 I FILENUM'=80,FILENUM'=81 Q
11 S DT6M=$$DT6M^PXRMCSU(DT)
12 S ILC=0
13 I FILENUM=80 D
14 . S IEN=0
15 . F S IEN=$O(^PXD(811.2,TAXIEN,"SDX","B",IEN)) Q:IEN="" D
16 .. S CODE=$$CODEC^ICDCODE(IEN)
17 .. S STATUS=+$$STATCHK^ICDAPIU(CODE,DT)
18 .. I 'STATUS S ICD9CLST(CODE_" ")=CODE
19 .. I STATUS D
20 ... S STATUS=+$$STATCHK^ICDAPIU(CODE,DT6M)
21 ... I 'STATUS S ICD9FLST(CODE_" ")=CODE
22 I FILENUM=81 D
23 . S IEN=0
24 . F S IEN=$O(^PXD(811.2,TAXIEN,"SPR","B",IEN)) Q:IEN="" D
25 .. S CODE=$$CODEC^ICPTCOD(IEN)
26 .. S STATUS=+$$STATCHK^ICPTAPIU(CODE,DT)
27 .. I 'STATUS S CPTCLST(CODE_" ")=CODE
28 I $D(ICD9CLST) D
29 . S IEN=""
30 . F S IEN=$O(ICD9CLST(IEN)) Q:IEN="" D
31 .. S CODE=ICD9CLST(IEN),ILC=ILC+1
32 .. S MSGARR(ILC)="Selectable ICD9 code "_CODE_" is inactive."
33 I $D(ICD9FLST) D
34 . S IEN=""
35 . F S IEN=$O(ICD9FLST(IEN)) Q:IEN="" D
36 .. S CODE=ICD9FLST(IEN),ILC=ILC+1
37 .. S MSGARR(ILC)="Selectable ICD9 code "_CODE_" will be inactive within 180 days."
38 I $D(CPTCLST) D
39 . S IEN=""
40 . F S IEN=$O(CPTCLST(IEN)) Q:IEN="" D
41 .. S CODE=CPTCLST(IEN),ILC=ILC+1
42 .. S MSGARR(ILC)="Selectable CPT code "_CODE_" is inactive."
43 I $D(CPTFLST) D
44 . S IEN=""
45 . F S IEN=$O(CPTFLST(IEN)) Q:IEN="" D
46 .. S CODE=CPTFLST(IEN),ILC=ILC+1
47 .. S MSGARR(ILC)="Selectable CPT code "_CODE_" will be inactive with 180 days."
48 I ILC>0 D
49 . S ILC=ILC+1,MSGARR(ILC)=" ",TAXMSG=1
50 . D ADDTMSG^PXRMCSTX(.LC,.MSGARR)
51 Q
52 ;
Note: See TracBrowser for help on using the repository browser.