source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXS1.m@ 1259

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1PXRMXS1 ; SLC/PJH - Reminder Reports DIC Prompts;10/11/2001
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;
5 ;Check for category reminders
6 ;----------------------------
7FOUND(CIEN) ;
8 N DATA,FOUND,RIEN,SUB
9 S FOUND=0,SUB=0
10 F S SUB=$O(^PXRMD(811.7,CIEN,2,SUB)) Q:SUB="" D Q:FOUND
11 .S DATA=$G(^PXRMD(811.7,CIEN,2,SUB,0)) Q:DATA=""
12 .S RIEN=$P(DATA,U) Q:RIEN=""
13 .;Ignore disabled reminders
14 .I '$P($G(^PXD(811.9,RIEN,0)),U,6) S FOUND=1
15 Q FOUND
16 ;
17 ;Add reminder category reminders to reminder array
18 ;-------------------------------------------------
19MERGE N RCIEN,RCNT,RCSUB,RIEN,RPNAM,RSUB,SUB
20 K ^TMP("PXRMXS1",$J)
21 K REMINDER
22 ;Extract each category in turn
23 S RCSUB=""
24 F S RCSUB=$O(PXRMRCAT(RCSUB)) Q:'RCSUB D
25 .S RCIEN=$P(PXRMRCAT(RCSUB),U) Q:'RCIEN
26 .;Add category reminders to reminder array
27 .D MREM(RCIEN,.REMINDER)
28 ;
29 ;Add individual reminders at the end
30 S SUB="",RSUB=+$O(REMINDER(""),-1)
31 F S SUB=$O(PXRMREM(SUB)) Q:'SUB D
32 .;Ignore duplicates
33 .S RIEN=$P(PXRMREM(SUB),U) Q:'RIEN Q:$D(^TMP("PXRMXS1",$J,RIEN))
34 .S RSUB=RSUB+1,REMINDER(RSUB)=PXRMREM(SUB),^TMP("PXRMXS1",$J,RIEN)=""
35 ;
36 K ^TMP("PXRMXS1",$J)
37 Q
38 ;
39MREM(CIEN,REM) ;Add to output array
40 N DATA,NAME,NREM,RIEN,PNAME,SEQ,SUB,TEMP
41 ;Add to end of list
42 S NREM=+$O(REM(""),-1)
43 ;
44 ;Sort Reminders from this category into display sequence
45 S SUB=0 K TEMP
46 F S SUB=$O(^PXRMD(811.7,CIEN,2,SUB)) Q:SUB="" D
47 .S DATA=$G(^PXRMD(811.7,CIEN,2,SUB,0)) Q:DATA=""
48 .;Ignore duplicates
49 .S RIEN=$P(DATA,U) Q:RIEN="" Q:$D(^TMP("PXRMXS1",$J,RIEN))
50 .S SEQ=$P(DATA,U,2)_0
51 .S DATA=$G(^PXD(811.9,RIEN,0))
52 .S NAME=$P(DATA,U),PNAME=$P(DATA,U,3)
53 .S TEMP(SEQ)=RIEN_U_NAME_U_NAME_U_PNAME
54 .S ^TMP("PXRMXS1",$J,RIEN)=""
55 ;
56 ;Re-save reminders in output array for display
57 ;unique number^type^name^parent^reminder ien
58 ;
59 S SEQ=""
60 F S SEQ=$O(TEMP(SEQ)) Q:SEQ="" D
61 .S NREM=NREM+1,REM(NREM)=TEMP(SEQ)
62 ;
63 ;Sort Sub-Categories for this category into display order
64 S SUB=0 K TEMP
65 F S SUB=$O(^PXRMD(811.7,CIEN,10,SUB)) Q:SUB="" D
66 .S DATA=$G(^PXRMD(811.7,CIEN,10,SUB,0)) Q:DATA=""
67 .S SEQ=$P(DATA,U,2),TEMP(SEQ)=SUB
68 ;
69 ;Process sub-sub categories in the same manner
70 S SEQ=""
71 F S SEQ=$O(TEMP(SEQ)) Q:SEQ="" D
72 .N IEN
73 .S SUB=TEMP(SEQ),IEN=$P($G(^PXRMD(811.7,CIEN,10,SUB,0)),U) Q:'IEN
74 .D MREM(IEN,.REM)
75 Q
76 ;
77 ;Check if a category has any sub-categories
78 ;------------------------------------------
79OK(CIEN) ;
80 ;Check in reminder multiple
81 I $$FOUND(CIEN) Q 1
82 ;
83 ;Otherwise check the sub-categories
84 N DATA,FOUND,IEN,SUB
85 S FOUND=0,SUB=0
86 F S SUB=$O(^PXRMD(811.7,CIEN,10,SUB)) Q:SUB="" D Q:FOUND
87 .S DATA=$G(^PXRMD(811.7,CIEN,10,SUB,0)) Q:DATA=""
88 .S IEN=$P(DATA,U) Q:'IEN
89 .;Check for active reminders in reminder multiple
90 .S FOUND=$$FOUND(IEN)
91 Q FOUND
Note: See TracBrowser for help on using the repository browser.