- 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 Feb 18, 2025@23:16:35 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 ;