source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXGUT.m@ 701

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

revised back to 6/30/08 version

File size: 2.2 KB
Line 
1PXRMXGUT ; SLC/PJH - General utilities for reminder reports; 05/31/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;=======================================
5EOR ;End of report display.
6 I $E(IOST)="C",IO=IO(0) D
7 . S DIR(0)="EA"
8 . S DIR("A")="End of the report. Press ENTER/RETURN to continue..."
9 . W !
10 . D ^DIR K DIR
11 Q
12 ;
13 ;=======================================
14EXIT ;Clean things up.
15 D ^%ZISC
16 D HOME^%ZIS
17 K IO("Q")
18 K DIRUT,DTOUT,DUOUT,POP
19 K ^TMP(PXRMXTMP)
20 K ^XTMP(PXRMXTMP)
21 K ^TMP("PXRMX",$J)
22 K ^TMP($J,"PXRM PATIENT LIST")
23 K ^TMP($J,"PXRM PATIENT EVAL")
24 K ^TMP($J,"PXRM FUTURE APPT")
25 K ^TMP($J,"PXRM FACILITY FUTURE APPT")
26 K ^TMP($J,"SDAMA301")
27 K ^TMP($J,"SORT")
28 Q
29 ;
30 ;=======================================
31VLIST(SLIST,LIST,MESSAGE) ;Make sure all the elements of LIST are in
32 ;SLIST. If they are, then LIST is valid. The elements of LIST can be
33 ;separated by commas and spaces.
34 N IC,LE,LEN,VALID
35 S LIST=$TR(LIST,",","")
36 S LIST=$TR(LIST," ","")
37 ;Make the test case insensitive.
38 S SLIST=$$UP^XLFSTR(SLIST)
39 S LIST=$$UP^XLFSTR(LIST)
40 S VALID=1
41 S LEN=$L(LIST)
42 I LEN=0 D
43 . W !,"The list is empty!"
44 . S VALID=0
45 F IC=1:1:LEN D
46 . S LE=$E(LIST,IC,IC)
47 . I SLIST'[LE D
48 .. W !,LE,MESSAGE
49 .. S VALID=0
50 Q VALID
51 ;
52 ;=======================================
53USTRINS(STRING,CHAR) ;Given a string, which is assumed to be in alphabetical
54 ;order and a character which is not already in the string insert the
55 ;character into the string in alphabetical order. For example:
56 ;STRING CHAR RETURNS
57 ;CEQ A ACEQ
58 ;CEQ E CEQ
59 ;CEQ F CEFQ
60 ;CEQ T CEQT
61 ;
62 N CH1,CH2,DONE,IC,LEN,STR
63 S LEN=$L(STRING)
64 ;Special case of empty STRING.
65 I LEN=0 Q CHAR
66 ;
67 S DONE=0
68 S STR=""
69 S CH1=$E(STRING,1,1)
70 I (CH1]CHAR) S STR=STR_CHAR_CH1,DONE=1
71 E S STR=STR_CH1
72 I CH1=CHAR S DONE=1
73 ;
74 ;Special case of STRING of length 1.
75 I (LEN=1)&('DONE) S STR=STR_CHAR,DONE=1
76 ;
77 F IC=2:1:LEN D
78 . S CH2=$E(STRING,IC,IC)
79 . I DONE S STR=STR_CH2
80 . E D
81 .. I (CHAR]CH1)&(CH2]CHAR) S STR=STR_CHAR_CH2,DONE=1
82 .. E S STR=STR_CH2
83 .. I CH2=CHAR S DONE=1
84 .. S CH1=CH2
85 ;
86 ;If we made it all the way through the loop and we are still not
87 ;done then append CHAR.
88 I ('DONE) S STR=STR_CHAR
89 Q STR
90 ;
Note: See TracBrowser for help on using the repository browser.