- PSSHFREQ ;WOIFO/AV - VALIDATES FREQUENCY FOR DOSING ;09/20/07
- ;;1.0;PHARMACY DATA MANAGEMENT;**136**;9/30/97;Build 89
- ;
- ;
- QUIT
- ;;
- VALFREQ(FREQ) ;
- ;
- NEW PSS,RSLT
- ;
- SET FREQ=$$TRIM(FREQ)
- ;
- ; Invalid frequency exit routine
- IF FREQ="" QUIT 0
- ;
- SET FREQ=$$UPPER(FREQ)
- ;
- ; Determine if frequency has decimals, if so invalid
- IF FREQ["." QUIT 0
- ; Determine if frequency is a number, if so it is valid
- IF FREQ?1.N QUIT 1
- ;
- ; Determine if frequency is one of the special frequency strings
- SET RSLT=$$SMPLFREQ(FREQ)
- IF RSLT=1 QUIT RSLT
- ;
- SET PSS("length")=$LENGTH(FREQ)
- SET PSS("firstCharacter")=$EXTRACT(FREQ,1,1)
- SET PSS("lastCharacter")=$EXTRACT(FREQ,PSS("length"),PSS("length"))
- ;
- ; Frequency must meet the following criteria else quit
- ; Length must be less than or equal to 4 or more than or equal to 3
- IF PSS("length")>4 QUIT 0
- IF PSS("length")<3 QUIT 0
- ; First character must be a Q or X
- ;IF (PSS("firstCharacter")'="Q")&&(PSS("firstCharacter")'="X") QUIT 0
- I "XQ"'[PSS("firstCharacter") Q 0
- ;
- SET PSS("result")=1
- IF PSS("length")=4 DO
- . ; Take two middle characters and ensure they are numbers
- . SET PSS("chrTemp1")=$EXTRACT(FREQ,2,2)
- . SET PSS("chrTemp2")=$EXTRACT(FREQ,3,3)
- . ; ASCII number characters are 48 - 57
- . SET PSS("intTemp1")=$ASCII(PSS("chrTemp1"))-48
- . SET PSS("intTemp2")=$ASCII(PSS("chrTemp2"))-48
- . ;
- . ; Ensure the two middle chars are numbers
- . IF PSS("intTemp1")<0 SET PSS("result")=0
- . IF PSS("intTemp1")>9 SET PSS("result")=0
- . IF PSS("intTemp2")<0 SET PSS("result")=0
- . IF PSS("intTemp2")>9 SET PSS("result")=0
- . QUIT
- ;
- IF PSS("length")=3 DO
- . ; Take two middle characters
- . SET PSS("chrTemp1")=$EXTRACT(FREQ,2,2)
- . ; ASCII number characters are 48 - 57
- . SET PSS("intTemp1")=$ASCII(PSS("chrTemp1"))-48
- . ;
- . ; Ensure the middle char is a number
- . IF PSS("intTemp1")<0 SET PSS("result")=0
- . IF PSS("intTemp1")>9 SET PSS("result")=0
- . QUIT
- ;
- IF PSS("result")=0 QUIT 0
- ;
- ; validate the first and last character
- ; If Q is first character
- SET PSS("qResult")=""
- IF PSS("firstCharacter")="Q" DO
- . IF PSS("lastCharacter")="D" SET PSS("qResult")=1 QUIT
- . IF PSS("lastCharacter")="W" SET PSS("qResult")=1 QUIT
- . IF PSS("lastCharacter")="L" SET PSS("qResult")=1 QUIT
- . IF PSS("lastCharacter")="H" SET PSS("qResult")=1 QUIT
- . IF PSS("qResult")="" SET PSS("qResult")=0
- . QUIT
- ;
- IF PSS("qResult")'="" QUIT PSS("qResult")
- ;
- ; If X is first character
- SET PSS("xResult")=""
- IF PSS("firstCharacter")="X" DO
- . IF PSS("lastCharacter")="D" SET PSS("xResult")=1 QUIT
- . IF PSS("lastCharacter")="W" SET PSS("xResult")=1 QUIT
- . IF PSS("lastCharacter")="L" SET PSS("xResult")=1 QUIT
- . IF PSS("xResult")="" SET PSS("xResult")=0
- . QUIT
- IF PSS("xResult")'="" QUIT PSS("xResult")
- ;
- QUIT 0
- ;;
- SMPLFREQ(FREQ) ;
- ; @DESC Determines if the frequency is one of the special
- ; frequency strings that is accepted
- ;
- ; @FREQ Frequency passed in
- ;
- ; @RETURNS 1 if is valid frequency or 0 if not one of special
- ; frequencies
- ;
- NEW VAL,RSLT,FREQS
- ;
- ; Hash of valid frequencies
- SET FREQS("QD")=""
- SET FREQS("BID")=""
- SET FREQS("TID")=""
- SET FREQS("QID")=""
- SET FREQS("QAM")=""
- SET FREQS("QSHIFT")=""
- SET FREQS("QOD")=""
- SET FREQS("QHS")=""
- SET FREQS("QPM")=""
- ;
- SET VAL=""
- SET RSLT=0
- FOR SET VAL=$ORDER(FREQS(VAL)) QUIT:VAL="" DO
- . ; Iterate through valid frequencies and determine
- . ; if frequency parameter is a match return 1
- . IF FREQ=VAL SET RSLT=1 QUIT
- . QUIT
- ;
- QUIT RSLT
- ;;
- TRIM(TEXT) ;
- ;Trims the leading and trailing whitespace from a String
- ;
- ;Trim leading whitespace
- SET TEXT=$$TRIMLEAD(TEXT)
- ;Trim trailing whitespace
- SET TEXT=$$TRIMEND(TEXT)
- QUIT TEXT
- ;;
- TRIMLEAD(TEXT) ;
- ;Trims the leading whitespace from a String
- ;
- NEW LENGTH,N,FLAG,CHAR,TEMPTEXT,MOD
- ;
- ;Ensure the String contains a value
- IF $DATA(TEXT)=0 SET TEXT="" QUIT TEXT
- SET LENGTH=$LENGTH(TEXT)
- ;Ensure the String is not empty
- IF LENGTH=0 QUIT TEXT
- ;
- ;Initialize the flag
- S FLAG=0,N=0,MOD=0
- ;Loop through
- FOR SET N=N+1 QUIT:N>LENGTH!(FLAG=1) DO
- .SET CHAR=$EXTRACT(TEXT,N)
- .IF CHAR=" " SET TEMPTEXT=$EXTRACT(TEXT,N+1,LENGTH),MOD=1
- .IF CHAR'=" " SET FLAG=1
- .QUIT ;End for loop
- ;Save the new text to the passed in variable
- IF MOD=1 SET TEXT=TEMPTEXT
- QUIT TEXT
- ;;
- TRIMEND(TEXT) ;
- ;Trims the trailing whitespace from a String
- ;
- NEW LENGTH,N,FLAG,CHAR,TEMPTEXT,MOD
- ;
- ;Ensure the String contains a value
- IF $DATA(TEXT)=0 SET TEXT="" QUIT TEXT
- SET LENGTH=$LENGTH(TEXT)
- ;Ensure the String is not empty
- IF LENGTH=0 QUIT TEXT
- ;
- ;Initialize the flag, counter, and modification indicator variables
- S FLAG=0,N=LENGTH+1,MOD=0
- ;Loop through
- FOR SET N=N-1 QUIT:N=0!(FLAG=1) DO
- .SET CHAR=$EXTRACT(TEXT,N)
- .;WRITE !,"CHAR: ",CHAR
- .IF CHAR=" " SET TEMPTEXT=$EXTRACT(TEXT,1,N-1),MOD=1
- .IF CHAR'=" " SET FLAG=1
- .QUIT ;End for loop
- ;Save the new text to the passed in variable
- IF MOD=1 SET TEXT=TEMPTEXT
- QUIT TEXT
- ;;
- UPPER(TEXT) ;
- ; @DESC Converts lowercase characters to uppercase
- ;
- ; @TEXT Text to be converted
- ;
- ; @RETURNS Text in all UPPPERCASE
- ;
- NEW LOWER,UPPER
- ;
- SET LOWER="abcdefghijklmnopqrstuvwxyz"
- SET UPPER="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- SET TEXT=$TRANSLATE(TEXT,LOWER,UPPER)
- ;
- QUIT TEXT
- ;;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSHFREQ 5430 printed Feb 18, 2025@23:57:45 Page 2
- PSSHFREQ ;WOIFO/AV - VALIDATES FREQUENCY FOR DOSING ;09/20/07
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**136**;9/30/97;Build 89
- +2 ;
- +3 ;
- +4 QUIT
- +5 ;;
- VALFREQ(FREQ) ;
- +1 ;
- +2 NEW PSS,RSLT
- +3 ;
- +4 SET FREQ=$$TRIM(FREQ)
- +5 ;
- +6 ; Invalid frequency exit routine
- +7 IF FREQ=""
- QUIT 0
- +8 ;
- +9 SET FREQ=$$UPPER(FREQ)
- +10 ;
- +11 ; Determine if frequency has decimals, if so invalid
- +12 IF FREQ["."
- QUIT 0
- +13 ; Determine if frequency is a number, if so it is valid
- +14 IF FREQ?1.N
- QUIT 1
- +15 ;
- +16 ; Determine if frequency is one of the special frequency strings
- +17 SET RSLT=$$SMPLFREQ(FREQ)
- +18 IF RSLT=1
- QUIT RSLT
- +19 ;
- +20 SET PSS("length")=$LENGTH(FREQ)
- +21 SET PSS("firstCharacter")=$EXTRACT(FREQ,1,1)
- +22 SET PSS("lastCharacter")=$EXTRACT(FREQ,PSS("length"),PSS("length"))
- +23 ;
- +24 ; Frequency must meet the following criteria else quit
- +25 ; Length must be less than or equal to 4 or more than or equal to 3
- +26 IF PSS("length")>4
- QUIT 0
- +27 IF PSS("length")<3
- QUIT 0
- +28 ; First character must be a Q or X
- +29 ;IF (PSS("firstCharacter")'="Q")&&(PSS("firstCharacter")'="X") QUIT 0
- +30 IF "XQ"'[PSS("firstCharacter")
- QUIT 0
- +31 ;
- +32 SET PSS("result")=1
- +33 IF PSS("length")=4
- Begin DoDot:1
- +34 ; Take two middle characters and ensure they are numbers
- +35 SET PSS("chrTemp1")=$EXTRACT(FREQ,2,2)
- +36 SET PSS("chrTemp2")=$EXTRACT(FREQ,3,3)
- +37 ; ASCII number characters are 48 - 57
- +38 SET PSS("intTemp1")=$ASCII(PSS("chrTemp1"))-48
- +39 SET PSS("intTemp2")=$ASCII(PSS("chrTemp2"))-48
- +40 ;
- +41 ; Ensure the two middle chars are numbers
- +42 IF PSS("intTemp1")<0
- SET PSS("result")=0
- +43 IF PSS("intTemp1")>9
- SET PSS("result")=0
- +44 IF PSS("intTemp2")<0
- SET PSS("result")=0
- +45 IF PSS("intTemp2")>9
- SET PSS("result")=0
- +46 QUIT
- End DoDot:1
- +47 ;
- +48 IF PSS("length")=3
- Begin DoDot:1
- +49 ; Take two middle characters
- +50 SET PSS("chrTemp1")=$EXTRACT(FREQ,2,2)
- +51 ; ASCII number characters are 48 - 57
- +52 SET PSS("intTemp1")=$ASCII(PSS("chrTemp1"))-48
- +53 ;
- +54 ; Ensure the middle char is a number
- +55 IF PSS("intTemp1")<0
- SET PSS("result")=0
- +56 IF PSS("intTemp1")>9
- SET PSS("result")=0
- +57 QUIT
- End DoDot:1
- +58 ;
- +59 IF PSS("result")=0
- QUIT 0
- +60 ;
- +61 ; validate the first and last character
- +62 ; If Q is first character
- +63 SET PSS("qResult")=""
- +64 IF PSS("firstCharacter")="Q"
- Begin DoDot:1
- +65 IF PSS("lastCharacter")="D"
- SET PSS("qResult")=1
- QUIT
- +66 IF PSS("lastCharacter")="W"
- SET PSS("qResult")=1
- QUIT
- +67 IF PSS("lastCharacter")="L"
- SET PSS("qResult")=1
- QUIT
- +68 IF PSS("lastCharacter")="H"
- SET PSS("qResult")=1
- QUIT
- +69 IF PSS("qResult")=""
- SET PSS("qResult")=0
- +70 QUIT
- End DoDot:1
- +71 ;
- +72 IF PSS("qResult")'=""
- QUIT PSS("qResult")
- +73 ;
- +74 ; If X is first character
- +75 SET PSS("xResult")=""
- +76 IF PSS("firstCharacter")="X"
- Begin DoDot:1
- +77 IF PSS("lastCharacter")="D"
- SET PSS("xResult")=1
- QUIT
- +78 IF PSS("lastCharacter")="W"
- SET PSS("xResult")=1
- QUIT
- +79 IF PSS("lastCharacter")="L"
- SET PSS("xResult")=1
- QUIT
- +80 IF PSS("xResult")=""
- SET PSS("xResult")=0
- +81 QUIT
- End DoDot:1
- +82 IF PSS("xResult")'=""
- QUIT PSS("xResult")
- +83 ;
- +84 QUIT 0
- +85 ;;
- SMPLFREQ(FREQ) ;
- +1 ; @DESC Determines if the frequency is one of the special
- +2 ; frequency strings that is accepted
- +3 ;
- +4 ; @FREQ Frequency passed in
- +5 ;
- +6 ; @RETURNS 1 if is valid frequency or 0 if not one of special
- +7 ; frequencies
- +8 ;
- +9 NEW VAL,RSLT,FREQS
- +10 ;
- +11 ; Hash of valid frequencies
- +12 SET FREQS("QD")=""
- +13 SET FREQS("BID")=""
- +14 SET FREQS("TID")=""
- +15 SET FREQS("QID")=""
- +16 SET FREQS("QAM")=""
- +17 SET FREQS("QSHIFT")=""
- +18 SET FREQS("QOD")=""
- +19 SET FREQS("QHS")=""
- +20 SET FREQS("QPM")=""
- +21 ;
- +22 SET VAL=""
- +23 SET RSLT=0
- +24 FOR
- SET VAL=$ORDER(FREQS(VAL))
- if VAL=""
- QUIT
- Begin DoDot:1
- +25 ; Iterate through valid frequencies and determine
- +26 ; if frequency parameter is a match return 1
- +27 IF FREQ=VAL
- SET RSLT=1
- QUIT
- +28 QUIT
- End DoDot:1
- +29 ;
- +30 QUIT RSLT
- +31 ;;
- TRIM(TEXT) ;
- +1 ;Trims the leading and trailing whitespace from a String
- +2 ;
- +3 ;Trim leading whitespace
- +4 SET TEXT=$$TRIMLEAD(TEXT)
- +5 ;Trim trailing whitespace
- +6 SET TEXT=$$TRIMEND(TEXT)
- +7 QUIT TEXT
- +8 ;;
- TRIMLEAD(TEXT) ;
- +1 ;Trims the leading whitespace from a String
- +2 ;
- +3 NEW LENGTH,N,FLAG,CHAR,TEMPTEXT,MOD
- +4 ;
- +5 ;Ensure the String contains a value
- +6 IF $DATA(TEXT)=0
- SET TEXT=""
- QUIT TEXT
- +7 SET LENGTH=$LENGTH(TEXT)
- +8 ;Ensure the String is not empty
- +9 IF LENGTH=0
- QUIT TEXT
- +10 ;
- +11 ;Initialize the flag
- +12 SET FLAG=0
- SET N=0
- SET MOD=0
- +13 ;Loop through
- +14 FOR
- SET N=N+1
- if N>LENGTH!(FLAG=1)
- QUIT
- Begin DoDot:1
- +15 SET CHAR=$EXTRACT(TEXT,N)
- +16 IF CHAR=" "
- SET TEMPTEXT=$EXTRACT(TEXT,N+1,LENGTH)
- SET MOD=1
- +17 IF CHAR'=" "
- SET FLAG=1
- +18 ;End for loop
- QUIT
- End DoDot:1
- +19 ;Save the new text to the passed in variable
- +20 IF MOD=1
- SET TEXT=TEMPTEXT
- +21 QUIT TEXT
- +22 ;;
- TRIMEND(TEXT) ;
- +1 ;Trims the trailing whitespace from a String
- +2 ;
- +3 NEW LENGTH,N,FLAG,CHAR,TEMPTEXT,MOD
- +4 ;
- +5 ;Ensure the String contains a value
- +6 IF $DATA(TEXT)=0
- SET TEXT=""
- QUIT TEXT
- +7 SET LENGTH=$LENGTH(TEXT)
- +8 ;Ensure the String is not empty
- +9 IF LENGTH=0
- QUIT TEXT
- +10 ;
- +11 ;Initialize the flag, counter, and modification indicator variables
- +12 SET FLAG=0
- SET N=LENGTH+1
- SET MOD=0
- +13 ;Loop through
- +14 FOR
- SET N=N-1
- if N=0!(FLAG=1)
- QUIT
- Begin DoDot:1
- +15 SET CHAR=$EXTRACT(TEXT,N)
- +16 ;WRITE !,"CHAR: ",CHAR
- +17 IF CHAR=" "
- SET TEMPTEXT=$EXTRACT(TEXT,1,N-1)
- SET MOD=1
- +18 IF CHAR'=" "
- SET FLAG=1
- +19 ;End for loop
- QUIT
- End DoDot:1
- +20 ;Save the new text to the passed in variable
- +21 IF MOD=1
- SET TEXT=TEMPTEXT
- +22 QUIT TEXT
- +23 ;;
- UPPER(TEXT) ;
- +1 ; @DESC Converts lowercase characters to uppercase
- +2 ;
- +3 ; @TEXT Text to be converted
- +4 ;
- +5 ; @RETURNS Text in all UPPPERCASE
- +6 ;
- +7 NEW LOWER,UPPER
- +8 ;
- +9 SET LOWER="abcdefghijklmnopqrstuvwxyz"
- +10 SET UPPER="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- +11 SET TEXT=$TRANSLATE(TEXT,LOWER,UPPER)
- +12 ;
- +13 QUIT TEXT
- +14 ;;