| [636] | 1 | PXRMXGUT ; SLC/PJH - General utilities for reminder reports; 05/31/2006
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
|---|
| [628] | 3 | ;
|
|---|
| 4 | ;=======================================
|
|---|
| 5 | EOR ;End of report display.
|
|---|
| [636] | 6 | I $E(IOST)="C",IO=IO(0) D
|
|---|
| [628] | 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 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 | ;=======================================
|
|---|
| [636] | 31 | VLIST(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
|
|---|
| [628] | 51 | ;
|
|---|
| 52 | ;=======================================
|
|---|
| 53 | USTRINS(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 | ;
|
|---|
