DVBAUDSTR1 ;ALB/CP - UTL Reusable String Functions #1 ; 10/11/18 2:03pm
;;2.7;AMIE;**256**;;Build 19
; Per VHA Directive 6402 this routine should not be modified
; $$GET1^DIQ ; IA # 2056
; ^DIC(49, ; IA # 2939
; $$UP^XLFSTR ; IA #10104
Q
;
FREETEXT(DVBTEXT) ; Extrinsic function: See Output below.
;
S DVBTEXT=$$UP^XLFSTR(DVBTEXT) ; Change all lowercase to uppercase
S DVBTEXT=$$STRIPSPA(DVBTEXT) ;. Strip any extra spaces found
Q DVBTEXT ; FREETEXT
;
HOSTSITE(DVBFORMAT) ; Extrinsic function: See Output below.
;
N DVBDEFINSTI
;
S DVBFORMAT=$G(DVBFORMAT,"SN") ; Default output DVBFORMAT: STATION NUMBER #99
S DVBFORMAT=$$UP^XLFSTR(DVBFORMAT) ; Allows uppercase of lowercase input
S:"^E^I^SN^"'[("^"_DVBFORMAT_"^") DVBFORMAT="SN" ;In case garbage is passed
S DVBDEFINSTI=$$GET1^DIQ(8989.3,"1,",217,"I") ; DEFAULT INSTITUTION #217
I DVBFORMAT="I" Q DVBDEFINSTI ;.......................... Pointer to file 4
I DVBFORMAT="SN" Q $$GET1^DIQ(4,DVBDEFINSTI_",",99,"E") ; Station number
Q $$GET1^DIQ(4,DVBDEFINSTI_",",.01,"E") ; DVBNAME #.01 ; HOSTSITE
;
ISPARSVC(DVBSVCI) ; Extrinsic function: See Output below.
;
Q $E(+$D(^DIC(49,"ACHLD",DVBSVCI))) ; ISPARSVC
;
;
LASTNAME(DVBNAME,DVBFORMAT) ; Extrinsic function: See Output below.
;
S DVBFORMAT=$G(DVBFORMAT,1) I "^1^2^"'[DVBFORMAT S DVBFORMAT=1
I DVBFORMAT=2 Q $P(DVBNAME,",")
Q $E(DVBNAME,1,$F(DVBNAME,",")) ; Default DVBFORMAT of 1 ; LASTNAME
;
POSINT(DVBINPUT) ; Extrinsic function: See Output below.
;
N DVBRETURN S DVBRETURN=0
; ZEXCEPT: N
;
I DVBINPUT?1N.N S DVBRETURN=1
I DVBINPUT<0 S DVBRETURN=0
Q DVBRETURN ; POSINT
;
SPACETXT(DVBTEXT) ; Extrinsic function: See Output below.
;
N DVBPOS,DVBVALUE
Q:$G(DVBTEXT)="" ""
Q:$L(DVBTEXT)=1 DVBTEXT
S DVBVALUE=""
F DVBPOS=1:1:$L(DVBTEXT) D ;
. S DVBVALUE=DVBVALUE_$E(DVBTEXT,DVBPOS,DVBPOS)
. S:DVBPOS<$L(DVBTEXT) DVBVALUE=DVBVALUE_" " ; Don't add a space after last DVBCHAR
Q DVBVALUE ; SPACETXT
;
STRIPSPA(DVBTEXT) ; Extrinsic function: See Output below.
;
S DVBTEXT=$$STRIPSPL(DVBTEXT) ;. Strip leading spaces
S DVBTEXT=$$STRIPSPE(DVBTEXT) ;. Strip spaces at the end
S DVBTEXT=$$STRIPSPX(DVBTEXT) ;. Strip extra spaces between words
Q DVBTEXT ; STRIPSPA
;
STRIPSPE(DVBTEXT) ; Extrinsic function: See Output below.
;
N DVBCHAR,DVBPOS,DVBQUIT
S DVBQUIT=0
F DVBPOS=$L(DVBTEXT):-1:1 D Q:DVBQUIT ;
. S DVBCHAR=$E(DVBTEXT,DVBPOS,DVBPOS)
. I $A(DVBCHAR)=32 S DVBTEXT=$E(DVBTEXT,1,DVBPOS-1)
. I $A(DVBCHAR)>32 S DVBQUIT=1 Q
Q DVBTEXT ; STRIPSPE
;
STRIPSPL(DVBTEXT) ; Extrinsic function: See Output below.
;
N DVBPOS,DVBVALUE
I $E(DVBTEXT) Q DVBTEXT
F DVBPOS=1:1:$L(DVBTEXT) Q:$E(DVBTEXT,DVBPOS,DVBPOS)'=" "
S DVBVALUE=$E(DVBTEXT,DVBPOS,$L(DVBTEXT)) I DVBVALUE=" " S DVBVALUE=""
Q DVBVALUE ; STRIPSPL
;
STRIPSPX(DVBTEXT) ; Extrinsic function: See Output below.
;
N DVBPOS
I $L(DVBTEXT)<2 Q DVBTEXT
F DVBPOS=1:1:$L(DVBTEXT) I $E(DVBTEXT,DVBPOS,DVBPOS+1)=" " D ;
. S DVBTEXT=$E(DVBTEXT,1,DVBPOS)_$E(DVBTEXT,DVBPOS+2,999)
. S DVBPOS=1
Q DVBTEXT ; STRIPSPX
;
YESNO(DVBVALUE) ; Extrinsic function: See Output below.
;
S DVBVALUE=$$UP^XLFSTR(DVBVALUE)
Q $S(DVBVALUE=0:"NO",DVBVALUE=1:"YES",DVBVALUE="N":"NO",DVBVALUE="Y":"YES",1:"") ; YESNO
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAUDSTR1 3335 printed Sep 17, 2026@20:27:29 Page 2
DVBAUDSTR1 ;ALB/CP - UTL Reusable String Functions #1 ; 10/11/18 2:03pm
+1 ;;2.7;AMIE;**256**;;Build 19
+2 ; Per VHA Directive 6402 this routine should not be modified
+3 ; $$GET1^DIQ ; IA # 2056
+4 ; ^DIC(49, ; IA # 2939
+5 ; $$UP^XLFSTR ; IA #10104
+6 QUIT
+7 ;
FREETEXT(DVBTEXT) ; Extrinsic function: See Output below.
+1 ;
+2 ; Change all lowercase to uppercase
SET DVBTEXT=$$UP^XLFSTR(DVBTEXT)
+3 ;. Strip any extra spaces found
SET DVBTEXT=$$STRIPSPA(DVBTEXT)
+4 ; FREETEXT
QUIT DVBTEXT
+5 ;
HOSTSITE(DVBFORMAT) ; Extrinsic function: See Output below.
+1 ;
+2 NEW DVBDEFINSTI
+3 ;
+4 ; Default output DVBFORMAT: STATION NUMBER #99
SET DVBFORMAT=$GET(DVBFORMAT,"SN")
+5 ; Allows uppercase of lowercase input
SET DVBFORMAT=$$UP^XLFSTR(DVBFORMAT)
+6 ;In case garbage is passed
if "^E^I^SN^"'[("^"_DVBFORMAT_"^")
SET DVBFORMAT="SN"
+7 ; DEFAULT INSTITUTION #217
SET DVBDEFINSTI=$$GET1^DIQ(8989.3,"1,",217,"I")
+8 ;.......................... Pointer to file 4
IF DVBFORMAT="I"
QUIT DVBDEFINSTI
+9 ; Station number
IF DVBFORMAT="SN"
QUIT $$GET1^DIQ(4,DVBDEFINSTI_",",99,"E")
+10 ; DVBNAME #.01 ; HOSTSITE
QUIT $$GET1^DIQ(4,DVBDEFINSTI_",",.01,"E")
+11 ;
ISPARSVC(DVBSVCI) ; Extrinsic function: See Output below.
+1 ;
+2 ; ISPARSVC
QUIT $EXTRACT(+$DATA(^DIC(49,"ACHLD",DVBSVCI)))
+3 ;
+4 ;
LASTNAME(DVBNAME,DVBFORMAT) ; Extrinsic function: See Output below.
+1 ;
+2 SET DVBFORMAT=$GET(DVBFORMAT,1)
IF "^1^2^"'[DVBFORMAT
SET DVBFORMAT=1
+3 IF DVBFORMAT=2
QUIT $PIECE(DVBNAME,",")
+4 ; Default DVBFORMAT of 1 ; LASTNAME
QUIT $EXTRACT(DVBNAME,1,$FIND(DVBNAME,","))
+5 ;
POSINT(DVBINPUT) ; Extrinsic function: See Output below.
+1 ;
+2 NEW DVBRETURN
SET DVBRETURN=0
+3 ; ZEXCEPT: N
+4 ;
+5 IF DVBINPUT?1N.N
SET DVBRETURN=1
+6 IF DVBINPUT<0
SET DVBRETURN=0
+7 ; POSINT
QUIT DVBRETURN
+8 ;
SPACETXT(DVBTEXT) ; Extrinsic function: See Output below.
+1 ;
+2 NEW DVBPOS,DVBVALUE
+3 if $GET(DVBTEXT)=""
QUIT ""
+4 if $LENGTH(DVBTEXT)=1
QUIT DVBTEXT
+5 SET DVBVALUE=""
+6 ;
FOR DVBPOS=1:1:$LENGTH(DVBTEXT)
Begin DoDot:1
+7 SET DVBVALUE=DVBVALUE_$EXTRACT(DVBTEXT,DVBPOS,DVBPOS)
+8 ; Don't add a space after last DVBCHAR
if DVBPOS<$LENGTH(DVBTEXT)
SET DVBVALUE=DVBVALUE_" "
End DoDot:1
+9 ; SPACETXT
QUIT DVBVALUE
+10 ;
STRIPSPA(DVBTEXT) ; Extrinsic function: See Output below.
+1 ;
+2 ;. Strip leading spaces
SET DVBTEXT=$$STRIPSPL(DVBTEXT)
+3 ;. Strip spaces at the end
SET DVBTEXT=$$STRIPSPE(DVBTEXT)
+4 ;. Strip extra spaces between words
SET DVBTEXT=$$STRIPSPX(DVBTEXT)
+5 ; STRIPSPA
QUIT DVBTEXT
+6 ;
STRIPSPE(DVBTEXT) ; Extrinsic function: See Output below.
+1 ;
+2 NEW DVBCHAR,DVBPOS,DVBQUIT
+3 SET DVBQUIT=0
+4 ;
FOR DVBPOS=$LENGTH(DVBTEXT):-1:1
Begin DoDot:1
+5 SET DVBCHAR=$EXTRACT(DVBTEXT,DVBPOS,DVBPOS)
+6 IF $ASCII(DVBCHAR)=32
SET DVBTEXT=$EXTRACT(DVBTEXT,1,DVBPOS-1)
+7 IF $ASCII(DVBCHAR)>32
SET DVBQUIT=1
QUIT
End DoDot:1
if DVBQUIT
QUIT
+8 ; STRIPSPE
QUIT DVBTEXT
+9 ;
STRIPSPL(DVBTEXT) ; Extrinsic function: See Output below.
+1 ;
+2 NEW DVBPOS,DVBVALUE
+3 IF $EXTRACT(DVBTEXT)
QUIT DVBTEXT
+4 FOR DVBPOS=1:1:$LENGTH(DVBTEXT)
if $EXTRACT(DVBTEXT,DVBPOS,DVBPOS)'=" "
QUIT
+5 SET DVBVALUE=$EXTRACT(DVBTEXT,DVBPOS,$LENGTH(DVBTEXT))
IF DVBVALUE=" "
SET DVBVALUE=""
+6 ; STRIPSPL
QUIT DVBVALUE
+7 ;
STRIPSPX(DVBTEXT) ; Extrinsic function: See Output below.
+1 ;
+2 NEW DVBPOS
+3 IF $LENGTH(DVBTEXT)<2
QUIT DVBTEXT
+4 ;
FOR DVBPOS=1:1:$LENGTH(DVBTEXT)
IF $EXTRACT(DVBTEXT,DVBPOS,DVBPOS+1)=" "
Begin DoDot:1
+5 SET DVBTEXT=$EXTRACT(DVBTEXT,1,DVBPOS)_$EXTRACT(DVBTEXT,DVBPOS+2,999)
+6 SET DVBPOS=1
End DoDot:1
+7 ; STRIPSPX
QUIT DVBTEXT
+8 ;
YESNO(DVBVALUE) ; Extrinsic function: See Output below.
+1 ;
+2 SET DVBVALUE=$$UP^XLFSTR(DVBVALUE)
+3 ; YESNO
QUIT $SELECT(DVBVALUE=0:"NO",DVBVALUE=1:"YES",DVBVALUE="N":"NO",DVBVALUE="Y":"YES",1:"")
+4 ;
