PXRMXGUT ; SLC/PJH - General utilities for reminder reports; 11/16/2007
;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
;
;=======================================
EOR ;End of report display.
I $E(IOST,1,2)="C-",IO=IO(0) D
. S DIR(0)="EA"
. S DIR("A")="End of the report. Press ENTER/RETURN to continue..."
. W !
. D ^DIR K DIR
Q
;
;=======================================
EXIT ;Clean things up.
D ^%ZISC
D HOME^%ZIS
K IO("Q")
K DIRUT,DTOUT,DUOUT,POP
K ^TMP(PXRMXTMP)
K ^XTMP(PXRMXTMP)
K ^TMP("PXRMX",$J)
K ^TMP($J,"PXRM PATIENT LIST")
K ^TMP($J,"PXRM PATIENT EVAL")
K ^TMP($J,"PXRM FUTURE APPT")
K ^TMP($J,"PXRM FACILITY FUTURE APPT")
K ^TMP($J,"SDAMA301")
K ^TMP($J,"SORT")
Q
;
;=======================================
TIMING ;Print report timing data.
N IND
W !!,"Report timing data:"
S IND=""
F S IND=$O(^XTMP(PXRMXTMP,"TIMING",IND)) Q:IND="" W !," ",^XTMP(PXRMXTMP,"TIMING",IND)
Q
;
;=======================================
USTRINS(STRING,CHAR) ;Given a string, which is assumed to be in alphabetical
;order and a character which is not already in the string insert the
;character into the string in alphabetical order. For example:
;STRING CHAR RETURNS
;CEQ A ACEQ
;CEQ E CEQ
;CEQ F CEFQ
;CEQ T CEQT
;
N CH1,CH2,DONE,IC,LEN,STR
S LEN=$L(STRING)
;Special case of empty STRING.
I LEN=0 Q CHAR
;
S DONE=0
S STR=""
S CH1=$E(STRING,1,1)
I (CH1]CHAR) S STR=STR_CHAR_CH1,DONE=1
E S STR=STR_CH1
I CH1=CHAR S DONE=1
;
;Special case of STRING of length 1.
I (LEN=1)&('DONE) S STR=STR_CHAR,DONE=1
;
F IC=2:1:LEN D
. S CH2=$E(STRING,IC,IC)
. I DONE S STR=STR_CH2
. E D
.. I (CHAR]CH1)&(CH2]CHAR) S STR=STR_CHAR_CH2,DONE=1
.. E S STR=STR_CH2
.. I CH2=CHAR S DONE=1
.. S CH1=CH2
;
;If we made it all the way through the loop and we are still not
;done then append CHAR.
I ('DONE) S STR=STR_CHAR
Q STR
;
;=======================================
VLIST(SLIST,LIST,MESSAGE) ;Make sure all the elements of LIST are in
;SLIST. If they are, then LIST is valid. The elements of LIST can be
;separated by commas and spaces.
N IC,LE,LEN,VALID
S LIST=$TR(LIST,",","")
S LIST=$TR(LIST," ","")
;Make the test case insensitive.
S SLIST=$$UP^XLFSTR(SLIST)
S LIST=$$UP^XLFSTR(LIST)
S VALID=1
S LEN=$L(LIST)
I LEN=0 D
. W !,"The list is empty!"
. S VALID=0
F IC=1:1:LEN D
. S LE=$E(LIST,IC,IC)
. I SLIST'[LE D
.. W !,LE,MESSAGE
.. S VALID=0
Q VALID
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXGUT 2558 printed Dec 13, 2024@01:50:13 Page 2
PXRMXGUT ; SLC/PJH - General utilities for reminder reports; 11/16/2007
+1 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
+2 ;
+3 ;=======================================
EOR ;End of report display.
+1 IF $EXTRACT(IOST,1,2)="C-"
IF IO=IO(0)
Begin DoDot:1
+2 SET DIR(0)="EA"
+3 SET DIR("A")="End of the report. Press ENTER/RETURN to continue..."
+4 WRITE !
+5 DO ^DIR
KILL DIR
End DoDot:1
+6 QUIT
+7 ;
+8 ;=======================================
EXIT ;Clean things up.
+1 DO ^%ZISC
+2 DO HOME^%ZIS
+3 KILL IO("Q")
+4 KILL DIRUT,DTOUT,DUOUT,POP
+5 KILL ^TMP(PXRMXTMP)
+6 KILL ^XTMP(PXRMXTMP)
+7 KILL ^TMP("PXRMX",$JOB)
+8 KILL ^TMP($JOB,"PXRM PATIENT LIST")
+9 KILL ^TMP($JOB,"PXRM PATIENT EVAL")
+10 KILL ^TMP($JOB,"PXRM FUTURE APPT")
+11 KILL ^TMP($JOB,"PXRM FACILITY FUTURE APPT")
+12 KILL ^TMP($JOB,"SDAMA301")
+13 KILL ^TMP($JOB,"SORT")
+14 QUIT
+15 ;
+16 ;=======================================
TIMING ;Print report timing data.
+1 NEW IND
+2 WRITE !!,"Report timing data:"
+3 SET IND=""
+4 FOR
SET IND=$ORDER(^XTMP(PXRMXTMP,"TIMING",IND))
if IND=""
QUIT
WRITE !," ",^XTMP(PXRMXTMP,"TIMING",IND)
+5 QUIT
+6 ;
+7 ;=======================================
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
+2 ;character into the string in alphabetical order. For example:
+3 ;STRING CHAR RETURNS
+4 ;CEQ A ACEQ
+5 ;CEQ E CEQ
+6 ;CEQ F CEFQ
+7 ;CEQ T CEQT
+8 ;
+9 NEW CH1,CH2,DONE,IC,LEN,STR
+10 SET LEN=$LENGTH(STRING)
+11 ;Special case of empty STRING.
+12 IF LEN=0
QUIT CHAR
+13 ;
+14 SET DONE=0
+15 SET STR=""
+16 SET CH1=$EXTRACT(STRING,1,1)
+17 IF (CH1]CHAR)
SET STR=STR_CHAR_CH1
SET DONE=1
+18 IF '$TEST
SET STR=STR_CH1
+19 IF CH1=CHAR
SET DONE=1
+20 ;
+21 ;Special case of STRING of length 1.
+22 IF (LEN=1)&('DONE)
SET STR=STR_CHAR
SET DONE=1
+23 ;
+24 FOR IC=2:1:LEN
Begin DoDot:1
+25 SET CH2=$EXTRACT(STRING,IC,IC)
+26 IF DONE
SET STR=STR_CH2
+27 IF '$TEST
Begin DoDot:2
+28 IF (CHAR]CH1)&(CH2]CHAR)
SET STR=STR_CHAR_CH2
SET DONE=1
+29 IF '$TEST
SET STR=STR_CH2
+30 IF CH2=CHAR
SET DONE=1
+31 SET CH1=CH2
End DoDot:2
End DoDot:1
+32 ;
+33 ;If we made it all the way through the loop and we are still not
+34 ;done then append CHAR.
+35 IF ('DONE)
SET STR=STR_CHAR
+36 QUIT STR
+37 ;
+38 ;=======================================
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
+2 ;separated by commas and spaces.
+3 NEW IC,LE,LEN,VALID
+4 SET LIST=$TRANSLATE(LIST,",","")
+5 SET LIST=$TRANSLATE(LIST," ","")
+6 ;Make the test case insensitive.
+7 SET SLIST=$$UP^XLFSTR(SLIST)
+8 SET LIST=$$UP^XLFSTR(LIST)
+9 SET VALID=1
+10 SET LEN=$LENGTH(LIST)
+11 IF LEN=0
Begin DoDot:1
+12 WRITE !,"The list is empty!"
+13 SET VALID=0
End DoDot:1
+14 FOR IC=1:1:LEN
Begin DoDot:1
+15 SET LE=$EXTRACT(LIST,IC,IC)
+16 IF SLIST'[LE
Begin DoDot:2
+17 WRITE !,LE,MESSAGE
+18 SET VALID=0
End DoDot:2
End DoDot:1
+19 QUIT VALID
+20 ;
