source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRRGUT.m@ 975

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1PXRRGUT ;ISL/PKR - General utilities for PCE Encounter reports. ;2/26/98
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**8,18,48**;Aug 12, 1996
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 DIRUT,DTOUT,DUOUT
18 K ^TMP(PXRRXTMP)
19 K ^XTMP(PXRRXTMP)
20 Q
21 ;
22 ;=======================================================================
23VLIST(SLIST,LIST,MESSAGE) ;Make sure all the elements of LIST are in
24 ;SLIST. If they are, then LIST is valid. The elements of LIST can be
25 ;separated by commas and spaces.
26 N IC,LE,LEN,VALID
27 S LIST=$TR(LIST,",","")
28 S LIST=$TR(LIST," ","")
29 ;Make the test case insensitive.
30 S SLIST=$$UP^XLFSTR(SLIST)
31 S LIST=$$UP^XLFSTR(LIST)
32 S VALID=1
33 S LEN=$L(LIST)
34 I LEN=0 D
35 . W !,"The list is empty!"
36 . S VALID=0
37 F IC=1:1:LEN D
38 . S LE=$E(LIST,IC,IC)
39 . I SLIST'[LE D
40 .. W !,LE,MESSAGE
41 .. S VALID=0
42 Q VALID
43 ;
44 ;=======================================================================
45USTRINS(STRING,CHAR) ;Given a string, which is assumed to be in alphabetical
46 ;order and a character which is not already in the string insert the
47 ;character into the string in alphabetical order. For example:
48 ;STRING CHAR RETURNS
49 ;CEQ A ACEQ
50 ;CEQ E CEQ
51 ;CEQ F CEFQ
52 ;CEQ T CEQT
53 ;
54 N CH1,CH2,DONE,IC,LEN,STR
55 S LEN=$L(STRING)
56 ;Special case of empty STRING.
57 I LEN=0 Q CHAR
58 ;
59 S DONE=0
60 S STR=""
61 S CH1=$E(STRING,1,1)
62 I (CH1]CHAR) S STR=STR_CHAR_CH1,DONE=1
63 E S STR=STR_CH1
64 I CH1=CHAR S DONE=1
65 ;
66 ;Special case of STRING of length 1.
67 I (LEN=1)&('DONE) S STR=STR_CHAR,DONE=1
68 ;
69 F IC=2:1:LEN D
70 . S CH2=$E(STRING,IC,IC)
71 . I DONE S STR=STR_CH2
72 . E D
73 .. I (CHAR]CH1)&(CH2]CHAR) S STR=STR_CHAR_CH2,DONE=1
74 .. E S STR=STR_CH2
75 .. I CH2=CHAR S DONE=1
76 .. S CH1=CH2
77 ;
78 ;If we made it all the way through the loop and we are still not
79 ;done then append CHAR.
80 I ('DONE) S STR=STR_CHAR
81 Q STR
82 ;
Note: See TracBrowser for help on using the repository browser.