source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLIST.m@ 1096

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

revised back to 6/30/08 version
File size: 2.9 KB
RevLine 
[623]1PXRMLIST ; SLC/PKR/PJH - Clinical Reminders list functions. ;10/04/2000
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;Used in the reminder exchange utility for building lists of
4 ;reminders, Exchange File entries, etc.
5 ;=======================================================
6FRDEF(NAME,PNAME) ;Format the reminder name and print name.
7 N IND,TEMP
8 S TEMP=$$LJ^XLFSTR(NAME,40," ")
9 S TEMP=TEMP_PNAME
10 Q TEMP
11 ;
12 ;=======================================================
13FRE(NUMBER,NAME,SOURCE,DATE) ;Format entry number, name, source,
14 ;and date packed.
15 N TEMP,TNAME,TSOURCE
16 S TEMP=$$RJ^XLFSTR(NUMBER,4," ")
17 S TNAME=$E(NAME,1,27)
18 S TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,29," ")
19 S TSOURCE=$E($P(SOURCE,",",1),1,12)_"@"_$E($P(SOURCE," at ",2),1,12)
20 S TEMP=TEMP_$$LJ^XLFSTR(TSOURCE,23," ")
21 S DATE=$$FMTE^XLFDT(DATE,"5Z")
22 S TEMP=TEMP_" "_$$LJ^XLFSTR(DATE,30," ")
23 Q TEMP
24 ;
25 ;=======================================================
26LIST ;Print a list of location lists.
27 N BY,DIC,FLDS,FR,L,PXRMEDOK
28 S PXRMEDOK=1
29 S BY=".01"
30 S DIC="^PXRMD(810.9,"
31 S FLDS="[PXRM LOCATION LIST LIST]"
32 S FR=""
33 S L=0
34 D EN1^DIP
35 Q
36 ;
37 ;=======================================================
38MRKINACT(TEXT) ;Append the inactive mark to TEXT in column 77.
39 N IC,NSPA
40 S NSPA=77-$L(TEXT)
41 F IC=1:1:NSPA S TEXT=TEXT_" "
42 S TEXT=TEXT_"X"
43 Q TEXT
44 ;
45 ;=======================================================
46QUERYAO() ;See if the user wants only active reminders listed.
47 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
48 S DIR(0)="YA"
49 S DIR("A")="List active reminders only? "
50 S DIR("B")="Y"
51 W !
52 D ^DIR
53 Q Y
54 ;
55 ;=======================================================
56RDEF(DEFLIST,ARO) ;Build a list of the name and print name of all
57 ;reminder definitions.
58 N INACTIVE,IEN,NAME,PNAME,REMINDER
59 S INACTIVE=""
60 ;Build the list of reminders in alphabetical order.
61 S VALMCNT=0
62 S NAME=""
63 F S NAME=$O(^PXD(811.9,"B",NAME)) Q:NAME="" D
64 . S IEN=$O(^PXD(811.9,"B",NAME,""))
65 . S REMINDER=^PXD(811.9,IEN,0)
66 . S INACTIVE=$P(REMINDER,U,6)
67 . I (ARO)&(INACTIVE) Q
68 . S VALMCNT=VALMCNT+1
69 . S PNAME=$P(REMINDER,U,3)
70 . S DEFLIST(VALMCNT,0)=$$FRDEF(NAME,PNAME)
71 . I INACTIVE D
72 .. S DEFLIST(VALMCNT,0)=$$MRKINACT(DEFLIST(VALMCNT,0))
73 S DEFLIST("VALMCNT")=VALMCNT
74 Q
75 ;
76 ;=======================================================
77RE(RLIST,IEN) ;Build a list of repository entries.
78 N DATE,IND,NAME,SOURCE
79 ;Build the list in alphabetical order.
80 S VALMCNT=0
81 S NAME=""
82 F S NAME=$O(^PXD(811.8,"B",NAME)) Q:NAME="" D
83 . S DATE=""
84 . F S DATE=$O(^PXD(811.8,"B",NAME,DATE)) Q:DATE="" D
85 .. S IND=$O(^PXD(811.8,"B",NAME,DATE,""))
86 .. S SOURCE=$P(^PXD(811.8,IND,0),U,2)
87 .. S VALMCNT=VALMCNT+1
88 .. S RLIST(VALMCNT,0)=$$FRE(VALMCNT,NAME,SOURCE,DATE)
89 .. S IEN(VALMCNT)=IND
90 S RLIST("VALMCNT")=VALMCNT
91 Q
92 ;
93 ;=======================================================
94SPONSOR ;Print a list of Sponsors.
95 N BY,DIC,FLDS,FR,L,PXRMEDOK
96 S PXRMEDOK=1
97 S BY=".01"
98 S DIC="^PXRMD(811.6,"
99 S FLDS="[PXRM SPONSOR LIST]"
100 S FR=""
101 S L=0
102 D EN1^DIP
103 Q
104 ;
Note: See TracBrowser for help on using the repository browser.