Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMXGUT

PXRMXGUT.m

Go to the documentation of this file.
  1. PXRMXGUT ; SLC/PJH - General utilities for reminder reports; 11/16/2007
  1. ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
  1. ;
  1. ;=======================================
  1. EOR ;End of report display.
  1. I $E(IOST,1,2)="C-",IO=IO(0) D
  1. . S DIR(0)="EA"
  1. . S DIR("A")="End of the report. Press ENTER/RETURN to continue..."
  1. . W !
  1. . D ^DIR K DIR
  1. Q
  1. ;
  1. ;=======================================
  1. EXIT ;Clean things up.
  1. D ^%ZISC
  1. D HOME^%ZIS
  1. K IO("Q")
  1. K DIRUT,DTOUT,DUOUT,POP
  1. K ^TMP(PXRMXTMP)
  1. K ^XTMP(PXRMXTMP)
  1. K ^TMP("PXRMX",$J)
  1. K ^TMP($J,"PXRM PATIENT LIST")
  1. K ^TMP($J,"PXRM PATIENT EVAL")
  1. K ^TMP($J,"PXRM FUTURE APPT")
  1. K ^TMP($J,"PXRM FACILITY FUTURE APPT")
  1. K ^TMP($J,"SDAMA301")
  1. K ^TMP($J,"SORT")
  1. Q
  1. ;
  1. ;=======================================
  1. TIMING ;Print report timing data.
  1. N IND
  1. W !!,"Report timing data:"
  1. S IND=""
  1. F S IND=$O(^XTMP(PXRMXTMP,"TIMING",IND)) Q:IND="" W !," ",^XTMP(PXRMXTMP,"TIMING",IND)
  1. Q
  1. ;
  1. ;=======================================
  1. USTRINS(STRING,CHAR) ;Given a string, which is assumed to be in alphabetical
  1. ;order and a character which is not already in the string insert the
  1. ;character into the string in alphabetical order. For example:
  1. ;STRING CHAR RETURNS
  1. ;CEQ A ACEQ
  1. ;CEQ E CEQ
  1. ;CEQ F CEFQ
  1. ;CEQ T CEQT
  1. ;
  1. N CH1,CH2,DONE,IC,LEN,STR
  1. S LEN=$L(STRING)
  1. ;Special case of empty STRING.
  1. I LEN=0 Q CHAR
  1. ;
  1. S DONE=0
  1. S STR=""
  1. S CH1=$E(STRING,1,1)
  1. I (CH1]CHAR) S STR=STR_CHAR_CH1,DONE=1
  1. E S STR=STR_CH1
  1. I CH1=CHAR S DONE=1
  1. ;
  1. ;Special case of STRING of length 1.
  1. I (LEN=1)&('DONE) S STR=STR_CHAR,DONE=1
  1. ;
  1. F IC=2:1:LEN D
  1. . S CH2=$E(STRING,IC,IC)
  1. . I DONE S STR=STR_CH2
  1. . E D
  1. .. I (CHAR]CH1)&(CH2]CHAR) S STR=STR_CHAR_CH2,DONE=1
  1. .. E S STR=STR_CH2
  1. .. I CH2=CHAR S DONE=1
  1. .. S CH1=CH2
  1. ;
  1. ;If we made it all the way through the loop and we are still not
  1. ;done then append CHAR.
  1. I ('DONE) S STR=STR_CHAR
  1. Q STR
  1. ;
  1. ;=======================================
  1. VLIST(SLIST,LIST,MESSAGE) ;Make sure all the elements of LIST are in
  1. ;SLIST. If they are, then LIST is valid. The elements of LIST can be
  1. ;separated by commas and spaces.
  1. N IC,LE,LEN,VALID
  1. S LIST=$TR(LIST,",","")
  1. S LIST=$TR(LIST," ","")
  1. ;Make the test case insensitive.
  1. S SLIST=$$UP^XLFSTR(SLIST)
  1. S LIST=$$UP^XLFSTR(LIST)
  1. S VALID=1
  1. S LEN=$L(LIST)
  1. I LEN=0 D
  1. . W !,"The list is empty!"
  1. . S VALID=0
  1. F IC=1:1:LEN D
  1. . S LE=$E(LIST,IC,IC)
  1. . I SLIST'[LE D
  1. .. W !,LE,MESSAGE
  1. .. S VALID=0
  1. Q VALID
  1. ;