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

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

initial load of WorldVistAEHR
File size: 3.1 KB
RevLine 
[613]1PXRMLIST ; SLC/PKR/PJH - Clinical Reminders list functions. ;07/17/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
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 ;=======================================================
13FMT(NUMBER,NAME,SOURCE,DATE,FMTSTR,NL,OUTPUT) ;Format entry number, name,
14 ;source, and date packed for LM display.
15 N TEMP,TSOURCE
16 S TEMP=NUMBER_U_NAME
17 S TSOURCE=$E($P(SOURCE,",",1),1,12)_"@"_$E($P(SOURCE," at ",2),1,12)
18 S TEMP=TEMP_U_TSOURCE
19 S DATE=$$FMTE^XLFDT(DATE,"5Z")
20 S TEMP=TEMP_U_DATE
21 D COLFMT^PXRMTEXT(FMTSTR,TEMP," ",.NL,.OUTPUT)
22 Q
23 ;
24 ;=======================================================
25LIST ;Print a list of location lists.
26 N BY,DIC,FLDS,FR,L,PXRMEDOK
27 S PXRMEDOK=1
28 S BY=".01"
29 S DIC="^PXRMD(810.9,"
30 S FLDS="[PXRM LOCATION LIST LIST]"
31 S FR=""
32 S L=0
33 D EN1^DIP
34 Q
35 ;
36 ;=======================================================
37MRKINACT(TEXT) ;Append the inactive mark to TEXT in column 77.
38 N IC,NSPA
39 S NSPA=77-$L(TEXT)
40 F IC=1:1:NSPA S TEXT=TEXT_" "
41 S TEXT=TEXT_"X"
42 Q TEXT
43 ;
44 ;=======================================================
45QUERYAO() ;See if the user wants only active reminders listed.
46 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
47 S DIR(0)="YA"
48 S DIR("A")="List active reminders only? "
49 S DIR("B")="Y"
50 W !
51 D ^DIR
52 Q Y
53 ;
54 ;=======================================================
55RDEF(DEFLIST,ARO) ;Build a list of the name and print name of all
56 ;reminder definitions.
57 N INACTIVE,IEN,NAME,PNAME,REMINDER
58 S INACTIVE=""
59 ;Build the list of reminders in alphabetical order.
60 S VALMCNT=0
61 S NAME=""
62 F S NAME=$O(^PXD(811.9,"B",NAME)) Q:NAME="" D
63 . S IEN=$O(^PXD(811.9,"B",NAME,""))
64 . S REMINDER=^PXD(811.9,IEN,0)
65 . S INACTIVE=$P(REMINDER,U,6)
66 . I (ARO)&(INACTIVE) Q
67 . S VALMCNT=VALMCNT+1
68 . S PNAME=$P(REMINDER,U,3)
69 . S DEFLIST(VALMCNT,0)=$$FRDEF(NAME,PNAME)
70 . I INACTIVE D
71 .. S DEFLIST(VALMCNT,0)=$$MRKINACT(DEFLIST(VALMCNT,0))
72 S DEFLIST("VALMCNT")=VALMCNT
73 Q
74 ;
75 ;=======================================================
76REXL(RLIST) ;Build a list of exchange repository entries.
77 N DATE,EXIEN,FMTSTR,IND,NAME,NL,NUM,OUTPUT,SOURCE,STR
78 ;Build the list in alphabetical order.
79 S FMTSTR=$$LMFMTSTR^PXRMTEXT(.VALMDDF,"RLLL")
80 S (NUM,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 EXIEN=$O(^PXD(811.8,"B",NAME,DATE,""))
86 .. S SOURCE=$P(^PXD(811.8,EXIEN,0),U,2)
87 .. S NUM=NUM+1
88 .. S ^TMP(RLIST,$J,"SEL",NUM)=EXIEN
89 .. D FMT(NUM,NAME,SOURCE,DATE,FMTSTR,.NL,.OUTPUT)
90 .. F IND=1:1:NL D
91 ... S VALMCNT=VALMCNT+1,^TMP(RLIST,$J,VALMCNT,0)=OUTPUT(IND)
92 ... S ^TMP(RLIST,$J,"IDX",VALMCNT,NUM)=""
93 S ^TMP(RLIST,$J,"VALMCNT")=VALMCNT
94 Q
95 ;
96 ;=======================================================
97SPONSOR ;Print a list of Sponsors.
98 N BY,DIC,FLDS,FR,L,PXRMEDOK
99 S PXRMEDOK=1
100 S BY=".01"
101 S DIC="^PXRMD(811.6,"
102 S FLDS="[PXRM SPONSOR LIST]"
103 S FR=""
104 S L=0
105 D EN1^DIP
106 Q
107 ;
Note: See TracBrowser for help on using the repository browser.