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 Apr 09, 2024@21:33:39 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 ;;
