source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMCAT.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1PXRMCAT ; SLC/PJH - Edit/Inquire reminder categories ;01/05/2001
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;Called by option PXRM REMINDER CATEGORIES
5 ;
6START N DIC,PXRMHD,PXRMCAT,PXRMGTYP,Y
7SELECT ;General selection
8 S PXRMHD="Reminder Categories",PXRMGTYP="RCAT",PXRMCAT=""
9 D START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMCAT")
10 ;Should return a value
11 I PXRMCAT D G SELECT
12 .S PXRMHD="REMINDER CATEGORY NAME:"
13 .;Listman option
14 .D START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMCAT)
15END Q
16 ;
17 ;Build Category Inquiry array
18 ;----------------------------
19BUILD(ARRAY,D0) ;
20 N D1,IC,LEVEL,SEQ,TAB,TXT,TEMP
21 ;Category Description
22 S LEVEL=5 D DES
23 ;Reminders
24 S LEVEL=0 D REM
25 ;Sort Sub-category into display order
26 D SORT(D0,.TEMP)
27 ;Sub-category ... D0=IEN OF PARENT D1=NODE NUMBER IN 10 OF CHILD
28 S SEQ=0
29 F S SEQ=$O(TEMP(SEQ)) Q:'SEQ D
30 .S D1=TEMP(SEQ)
31 .D GETLST(D0,D1,0)
32 Q
33 ;
34 ;Build display for selected category - Called from PXRMGEN
35 ;---------------------------------------------------------
36CAT(PXRMCAT) ;
37 N DATA,DARRAY,SUB
38 S VALMCNT=0 K ^TMP("PXRMGENS",$J),^TMP("PXRMGEN",$J)
39 ;
40 ;Format headings to include category name
41 S HEADER=PXRMHD_" "_$P(^PXRMD(811.7,PXRMCAT,0),U)
42 ;
43 ;Build Reminder Category Display
44 D BUILD(.DARRAY,PXRMCAT) M ^TMP("PXRMGENS",$J)=DARRAY
45 ;
46 ;Put the list into the array List Manager is using.
47 S SUB="",VALMCNT=0
48 F S SUB=$O(^TMP("PXRMGENS",$J,SUB)) Q:SUB="" D
49 .S DATA=$G(^TMP("PXRMGENS",$J,SUB))
50 .S VALMCNT=VALMCNT+1
51 .S ^TMP("PXRMGEN",$J,VALMCNT,0)=DATA
52 K ^TMP("PXRMGENS",$J)
53 ;Create headings
54 D CHGCAP^VALM("HEADER1","")
55 D CHGCAP^VALM("HEADER2","")
56 D CHGCAP^VALM("HEADER3","")
57 Q
58 ;
59 ;Category description
60 ;--------------------
61DES ;array.
62 N DIWF,DIWL,DIWR,SUB,X
63 S DIWF="C70",DIWL=0,DIWR=70
64 K ^UTILITY($J,"W")
65 S SUB=0
66 F S SUB=$O(^PXRMD(811.7,D0,1,SUB)) Q:SUB="" D
67 .S X=$G(^PXRMD(811.7,D0,1,SUB,0))
68 .D ^DIWP
69 S ARRAY(1)="Category Description:",IC=1
70 F S SUB=$O(^UTILITY($J,"W",0,SUB)) Q:SUB="" D
71 .S IC=IC+1,ARRAY(IC)=$J("",LEVEL)_^UTILITY($J,"W",0,SUB,0)
72 K ^UTILITY($J,"W")
73 Q
74 ;
75 ;Get list of sub-categories
76 ;--------------------------
77GETLST(D0,D1,LEVEL) ;
78 N CHILD,DATA,NAME,PXRMIEN,PXRMCAT,PXRMSEQ,SEQ,SUB,TEMP
79 ;Determine if this subcategory has children
80 S DATA=$G(^PXRMD(811.7,D0,10,D1,0)) Q:DATA=""
81 S PXRMCAT=$P(DATA,U) Q:PXRMCAT=""
82 S PXRMSEQ=$P(DATA,U,2),NAME=$G(^PXRMD(811.7,PXRMCAT,0))
83 I NAME="" S NAME=PXRMCAT
84 I LEVEL=0 S IC=IC+1,ARRAY(IC)=""
85 S IC=IC+1,ARRAY(IC)=$J("",LEVEL)_"Sub-category:"_NAME
86 S ARRAY(IC)=ARRAY(IC)_$J("",38-$L(NAME))_" Sequence: "_PXRMSEQ
87 ;Increment tab
88 S LEVEL=LEVEL+5
89 ;Don't allow > 4 levels
90 I LEVEL>20 S IC=IC+1,ARRAY(IC)=$J("",LEVEL)_"Further levels" Q
91 ;Save details of reminders for this category
92 D REM
93 ;Sort Sub-categories into display order
94 D SORT(PXRMCAT,.TEMP)
95 ;
96 ;Process sub-sub categories in the same manner
97 S SEQ=""
98 F S SEQ=$O(TEMP(SEQ)) Q:SEQ="" D
99 .S SUB=TEMP(SEQ)
100 .D GETLST(PXRMCAT,SUB,LEVEL)
101 Q
102 ;
103 ;Reminders for this category
104 ;---------------------------
105REM S SUB=0 K TEMP
106 ;Sort Reminders from this category into display sequence
107 F S SUB=$O(^PXRMD(811.7,PXRMCAT,2,SUB)) Q:SUB="" D
108 .S DATA=$G(^PXRMD(811.7,PXRMCAT,2,SUB,0)) Q:DATA=""
109 .S PXRMIEN=$P(DATA,U) Q:PXRMIEN=""
110 .S SEQ=$P(DATA,U,2)
111 .S DATA=$G(^PXD(811.9,PXRMIEN,0)) Q:DATA=""
112 .S NAME=$P(DATA,U) I NAME="" S NAME="Unknown"
113 .S TEMP(SEQ_0)=NAME
114 ;
115 I LEVEL=0,$O(TEMP("")) S IC=IC+1,ARRAY(IC)=""
116 ;
117 ;Re-save reminders in output array for display
118 S SEQ=""
119 F S SEQ=$O(TEMP(SEQ)) Q:SEQ="" D
120 .S IC=IC+1
121 .S ARRAY(IC)=$J("",LEVEL)_"Sequence: "_$J(SEQ/10,2)_" Reminder: "_TEMP(SEQ)
122 Q
123 ;
124 ;Sort Sub-Categories for this category into display order
125 ;--------------------------------------------------------
126SORT(PXRMCAT,TEMP) ;
127 N DATA,SEQ,SUB
128 S SUB=0 K TEMP
129 F S SUB=$O(^PXRMD(811.7,PXRMCAT,10,SUB)) Q:SUB="" D
130 .S DATA=$G(^PXRMD(811.7,PXRMCAT,10,SUB,0)) Q:DATA=""
131 .S SEQ=$P(DATA,U,2),TEMP(SEQ)=SUB
132 Q
Note: See TracBrowser for help on using the repository browser.