| 1 | PXRRGUT ;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 | ;=======================================================================
|
|---|
| 5 | EOR ;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 | ;=======================================================================
|
|---|
| 14 | EXIT ;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 | ;=======================================================================
|
|---|
| 23 | VLIST(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 | ;=======================================================================
|
|---|
| 45 | USTRINS(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 | ;
|
|---|
