source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMPTTX.m@ 1800

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

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1PXRMPTTX ; SLC/PKR - Routines for taxonomy print templates ;04/09/2003
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;References to ICDAPIU DBIA #3991.
4 ;References to ICPTAPIU DBIA #1997.
5 ;=======================================================
6ICD0LIST ;Print expanded list of ICD0 codes.
7 N ACTDATE,CODE,DATA,INADATE,LOW,HIGH,TEMP,TEXT
8 S TEMP=^PXD(811.2,D0,80.1,D1,0)
9 S (ACTDATE,INADATE)=$$FMTE^XLFDT(DT,"5Z")
10 S LOW=$P(TEMP,U,1)
11 S HIGH=$P(TEMP,U,2)
12 I HIGH="" S HIGH=LOW
13 W !!,?2,"Code",?10,"ICD Operation/Procedure",?42,"Activation",?54,"Inactivation"
14 W !,?2,"----",?10,"-----------------------",?42,"----------",?54,"------------"
15 S CODE=LOW
16 F Q:(CODE]HIGH)!(CODE="") D
17 . K DATA
18 . D PERIOD^ICDAPIU(CODE,.DATA)
19 . S ACTDATE=0
20 . F S ACTDATE=$O(DATA(ACTDATE)) Q:ACTDATE="" D
21 .. S INADATE=$P(DATA(ACTDATE),U,1)
22 .. S TEXT=$P(DATA(ACTDATE),U,2)
23 .. S TEXT=$E(TEXT,1,30)
24 .. W !,?2,CODE,?10,TEXT,?42,$$FMTE^XLFDT(ACTDATE,"5Z"),?54,$$FMTE^XLFDT(INADATE,"5Z")
25 . S CODE=$$NEXT^ICDAPIU(CODE)
26 Q
27 ;
28 ;=======================================================
29ICD9LIST ;Print expanded list of ICD9 codes.
30 N ACTDATE,CODE,DATA,IEN,INADATE,LOW,HIGH,SEL,TEMP,TEXT
31 S TEMP=^PXD(811.2,D0,80,D1,0)
32 S LOW=$P(TEMP,U,1)
33 S HIGH=$P(TEMP,U,2)
34 I HIGH="" S HIGH=LOW
35 W !!,?2,"Code",?10,"ICD Diagnosis",?42,"Activation",?54,"Inactivation",?67,"Selectable"
36 W !,?2,"----",?10,"--------------",?42,"----------",?54,"------------",?67,"----------"
37 S CODE=LOW
38 F Q:(CODE]HIGH)!(CODE="") D
39 . K DATA
40 . D PERIOD^ICDAPIU(CODE,.DATA)
41 . S IEN=$P(DATA(0),U,1)
42 . S SEL=$S($D(^PXD(811.2,D0,"SDX","B",IEN)):"X",1:"")
43 . S ACTDATE=0
44 . F S ACTDATE=$O(DATA(ACTDATE)) Q:ACTDATE="" D
45 .. S INADATE=$P(DATA(ACTDATE),U,1)
46 .. S TEXT=$P(DATA(ACTDATE),U,2)
47 .. W !,?2,CODE,?10,TEXT,?42,$$FMTE^XLFDT(ACTDATE,"5Z"),?54,$$FMTE^XLFDT(INADATE,"5Z"),?71,SEL
48 . S CODE=$$NEXT^ICDAPIU(CODE)
49 Q
50 ;
51 ;=======================================================
52ICPTLIST ;Print expanded list of CPT codes.
53 N ACTDATE,CODE,DATA,IEN,INADATE,LOW,HIGH,SEL,TEMP,TEXT
54 S TEMP=^PXD(811.2,D0,81,D1,0)
55 S LOW=$P(TEMP,U,1)
56 S HIGH=$P(TEMP,U,2)
57 I HIGH="" S HIGH=LOW
58 W !!,?2,"Code",?10,"CPT Short Name",?42,"Activation",?54,"Inactivation",?67,"Selectable"
59 W !,?2,"----",?10,"--------------",?42,"----------",?54,"------------",?67,"----------"
60 S CODE=LOW
61 F Q:(CODE]HIGH)!(CODE="") D
62 . K DATA
63 . D PERIOD^ICPTAPIU(CODE,.DATA)
64 . S IEN=$P(DATA(0),U,1)
65 . S SEL=$S($D(^PXD(811.2,D0,"SPR","B",IEN)):"X",1:"")
66 . S ACTDATE=0
67 . F S ACTDATE=$O(DATA(ACTDATE)) Q:ACTDATE="" D
68 .. S INADATE=$P(DATA(ACTDATE),U,1)
69 .. S TEXT=$P(DATA(ACTDATE),U,2)
70 .. W !,?2,CODE,?10,TEXT,?42,$$FMTE^XLFDT(ACTDATE,"5Z"),?54,$$FMTE^XLFDT(INADATE,"5Z"),?71,SEL
71 . S CODE=$$NEXT^ICPTAPIU(CODE)
72 Q
73 ;
74 ;=======================================================
75TAXLIST ;Taxonomy list.
76 N CODES,CPT,CPTLIST,IC,ICD0,ICD0LIST,ICD9,ICD9LIST,IND,NCODES
77 S (IC,IND)=0
78 F S IND=+$O(^PXD(811.2,D0,80,IND)) Q:IND=0 D
79 . S IC=IC+1
80 . S CODES=^PXD(811.2,D0,80,IND,0)
81 . S ICD9LIST(IC)=CODES
82 S NCODES=IC
83 ;
84 S (IC,IND)=0
85 F S IND=+$O(^PXD(811.2,D0,80.1,IND)) Q:IND=0 D
86 . S IC=IC+1
87 . S CODES=^PXD(811.2,D0,80.1,IND,0)
88 . S ICD0LIST(IC)=CODES
89 S NCODES=$$MAX^XLFMTH(NCODES,IC)
90 ;
91 S (IC,IND)=0
92 F S IND=+$O(^PXD(811.2,D0,81,IND)) Q:IND=0 D
93 . S IC=IC+1
94 . S CODES=^PXD(811.2,D0,81,IND,0)
95 . S CPTLIST(IC)=CODES
96 S NCODES=$$MAX^XLFMTH(NCODES,IC)
97 ;Print the list.
98 F IC=1:1:NCODES D
99 . S ICD9=$G(ICD9LIST(IC))
100 . S ICD0=$G(ICD0LIST(IC))
101 . S CPT=$G(CPTLIST(IC))
102 . W !,?9,$P(ICD9,U,1),?19,$P(ICD9,U,2)
103 . W ?29,$P(ICD0,U,1),?39,$P(ICD0,U,2)
104 . W ?49,$P(CPT,U,1),?59,$P(CPT,U,2)
105 Q
106 ;
Note: See TracBrowser for help on using the repository browser.