Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXGUT.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXGUT.m
r613 r623 1 PXRMXGUT ; SLC/PJH - General utilities for reminder reports; 11/16/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ;======================================= 5 EOR ;End of report display. 6 I $E(IOST,1,2)="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 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 ;======================================= 31 TIMING ;Print report timing data. 32 N IND 33 W !!,"Report timing data:" 34 S IND="" 35 F S IND=$O(^XTMP(PXRMXTMP,"TIMING",IND)) Q:IND="" W !," ",^XTMP(PXRMXTMP,"TIMING",IND) 36 Q 37 ; 38 ;======================================= 39 USTRINS(STRING,CHAR) ;Given a string, which is assumed to be in alphabetical 40 ;order and a character which is not already in the string insert the 41 ;character into the string in alphabetical order. For example: 42 ;STRING CHAR RETURNS 43 ;CEQ A ACEQ 44 ;CEQ E CEQ 45 ;CEQ F CEFQ 46 ;CEQ T CEQT 47 ; 48 N CH1,CH2,DONE,IC,LEN,STR 49 S LEN=$L(STRING) 50 ;Special case of empty STRING. 51 I LEN=0 Q CHAR 52 ; 53 S DONE=0 54 S STR="" 55 S CH1=$E(STRING,1,1) 56 I (CH1]CHAR) S STR=STR_CHAR_CH1,DONE=1 57 E S STR=STR_CH1 58 I CH1=CHAR S DONE=1 59 ; 60 ;Special case of STRING of length 1. 61 I (LEN=1)&('DONE) S STR=STR_CHAR,DONE=1 62 ; 63 F IC=2:1:LEN D 64 . S CH2=$E(STRING,IC,IC) 65 . I DONE S STR=STR_CH2 66 . E D 67 .. I (CHAR]CH1)&(CH2]CHAR) S STR=STR_CHAR_CH2,DONE=1 68 .. E S STR=STR_CH2 69 .. I CH2=CHAR S DONE=1 70 .. S CH1=CH2 71 ; 72 ;If we made it all the way through the loop and we are still not 73 ;done then append CHAR. 74 I ('DONE) S STR=STR_CHAR 75 Q STR 76 ; 77 ;======================================= 78 VLIST(SLIST,LIST,MESSAGE) ;Make sure all the elements of LIST are in 79 ;SLIST. If they are, then LIST is valid. The elements of LIST can be 80 ;separated by commas and spaces. 81 N IC,LE,LEN,VALID 82 S LIST=$TR(LIST,",","") 83 S LIST=$TR(LIST," ","") 84 ;Make the test case insensitive. 85 S SLIST=$$UP^XLFSTR(SLIST) 86 S LIST=$$UP^XLFSTR(LIST) 87 S VALID=1 88 S LEN=$L(LIST) 89 I LEN=0 D 90 . W !,"The list is empty!" 91 . S VALID=0 92 F IC=1:1:LEN D 93 . S LE=$E(LIST,IC,IC) 94 . I SLIST'[LE D 95 .. W !,LE,MESSAGE 96 .. S VALID=0 97 Q VALID 98 ; 1 PXRMXGUT ; SLC/PJH - General utilities for reminder reports; 05/31/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 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 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 ;======================================= 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 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 ;
Note:
See TracChangeset
for help on using the changeset viewer.
