VAQUTL50 ;ALB/JRP - CREATE DATA SEGMENT FROM H.S. COMPONENT;Jun 07, 2023@11:47
;;1.5;PATIENT DATA EXCHANGE;**11,46**;NOV 17, 1993;Build 17
; Reference to ^GMT(142.1,D0,0) in ICR #814
ADDSEG(HSPTR,MAXTIME,MAXOCCUR) ;ADD NEW DATA SEGMENT USING H.S. COMPONENT
;INPUT : HSPTR - Pointer to HEALTH SUMMARY COMPONENT file (#142.1)
; MAXTIME - Max time limit allowed for auto processing
; MAXOCCUR - Max occurrence limit allowed for auto processing
;OUTPUT : 0 - VAQ - DATA SEGMENT file (#394.71) entry was successfully
; created
; -1^ErrorText - Entry not created
;NOTES : If time and/or occurrence limits do not apply to the
; component, MAXTIME and/or MAXOCCUR are not required.
; : If time and/or occurrence limits apply to the component,
; default values will be taken from the VAQ - PARAMETER
; file (#394.81). If parameter file does not contain these
; values, a default of 1 year and 10 occurrences will be used.
; : If a maximum limit is not valid, the default limit will
; be used.
;
;CHECK INPUT
S HSPTR=+$G(HSPTR)
Q:('HSPTR) "-1^Did not pass pointer to HEALTH SUMMARY COMPONENT file"
Q:('$D(^GMT(142.1,HSPTR,0))) "-1^Did not pass valid pointer to HEALTH SUMMARY COMPONENT file"
S MAXTIME=$G(MAXTIME)
S MAXOCCUR=$G(MAXOCCUR)
;DECLARE VARIABLES
N NAME,ABB,TMP
N X,Y,DIC,DINUM,DA,DIE,DR
;GET COMPONENT NAME & ABBREVIATION
S TMP=$G(^GMT(142.1,HSPTR,0))
S NAME=$P(TMP,U,1)
Q:(NAME="") "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain a name"
S ABB=$P(TMP,U,4)
Q:(ABB="") "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain an abbreviation"
;CONVERT NAME SO ONLY FIRST CHARACTER OF EVERY WORD IS IN UPPERCASE
S NAME=$$FIRSTUP(NAME)
;SEE IF NAME OR ABBREVIATION ALREADY EXIST IN DATA SEGMENT FILE
Q:($D(^VAT(394.71,"B",NAME))) "-1^"_NAME_" already exists in VAQ - DATA SEGMENT file"
Q:($D(^VAT(394.71,"CAPS",$$UP^XLFSTR(NAME)))) "-1^"_NAME_" already exists in VAQ - DATA SEGMENT file"
Q:($D(^VAT(394.71,"C",ABB))) "-1^Abbreviation of "_ABB_" already used in VAQ - DATA SEGMENT file"
D LIMITS(HSPTR,.MAXTIME,.MAXOCCUR)
;SET UP CALL TO FILEMAN & CREATE STUB
N VAQFDA,VAQERROR,VAQMESSAGE
S VAQFDA(394.71,"+1,",.01)=NAME
S VAQFDA(394.71,"+1,",.02)=ABB
S VAQFDA(394.71,"+1,",.03)="YES"
S VAQFDA(394.71,"+1,",.04)="`"_HSPTR
S VAQFDA(394.71,"+1,",.05)=MAXTIME
S VAQFDA(394.71,"+1,",.06)=MAXOCCUR
S VAQFDA(394.71,"+1,",10)="$$GET^GMTSPDX(TRAN,DFN,SEGPTR,ROOT,(OFFSET-1),TIMLIM,OCCLIM)"
S VAQFDA(394.71,"+1,",20)="@"
D UPDATE^DIE("E","VAQFDA",,"VAQERROR")
I $D(VAQERROR) D Q "-1"_U_VAQMESSAGE
.D MSG^DIALOG("AET",.VAQMESSAGE,,,"VAQERROR")
.N VAQLINE
.F VAQLINE=1:1:VAQMESSAGE D
..S VAQERROR=$S($G(VAQERROR)'="":VAQERROR_" ",1:"")_VAQMESSAGE(VAQLINE)
Q 0
LIMITS(VAQHSPTR,VAQMAXTIME,VAQMAXOCCUR) ;DETERMINE MAX TIME/OCCURRENCE LIMITS
;INPUT: VAQHSPTR - Pointer to HEALTH SUMMARY COMPONENT file (#142.1)
; VAQMAXTIME - Max time limit allowed for auto processing
; VQAMAXOCCUR - Max occurrence limit allowed for auto processing
;GET DEFAULT TIME AND OCCURRENCE LIMITS
N VAQIEN,VAQNLIMIT,VAQDEFTIME,VAQDEFOCCUR,VAQLIMIT,VAQTIME,VAQOCCUR
S VAQIEN=+$O(^VAT(394.81,0))
S VAQNLIMIT=$G(^VAT(394.81,VAQIEN,"LIMITS"))
S VAQDEFTIME=$P(VAQNLIMIT,U,1)
S:(VAQDEFTIME="") VAQDEFTIME="1Y"
S VAQDEFOCCUR=$P(VAQNLIMIT,U,2)
S:(VAQDEFOCCUR="") VAQDEFOCCUR=10
;DETERMINE IF TIME AND/OR OCCURRENCE LIMITS APPLY
S VAQLIMIT=$$LIMITS^VAQDBIH3(VAQHSPTR)
S VAQTIME=+VAQLIMIT,VAQOCCUR=+$P(VAQLIMIT,U,2)
;SET MAX LIMITS
I (VAQTIME) S:($$VALOCC^VAQDBIH2(VAQMAXTIME,0)<0) VAQMAXTIME=VAQDEFTIME
I ('VAQTIME) S VAQMAXTIME=""
I (VAQOCCUR) S:($$VALOCC^VAQDBIH2(VAQMAXOCCUR,1)<0) VAQMAXOCCUR=VAQDEFOCCUR
I ('VAQOCCUR) S VAQMAXOCCUR=""
Q
UPDSEG(VAQHSPTR,VAQMAXTIME,VAQMAXOCCUR) ;UPDATE EXISTING DATA SEGMENT USING H.S. COMPONENT
;INPUT : VAQHSPTR - Pointer to HEALTH SUMMARY COMPONENT file (#142.1)
; VAQMAXTIME - Max time limit allowed for auto processing
; VAQMAXOCCUR - Max occurrence limit allowed for auto processing
;OUTPUT : $$UPDSEG - 0 - VAQ - DATA SEGMENT file (#394.71) entry was successfully
; updated
; -1^ErrorText - Entry not updated
;NOTES : If time and/or occurrence limits do not apply to the
; component, MAXTIME and/or MAXOCCUR are not required.
; : If time and/or occurrence limits apply to the component,
; default values will be taken from the VAQ - PARAMETER
; file (#394.81). If parameter file does not contain these
; values, a default of 1 year and 10 occurrences will be used.
; : If a maximum limit is not valid, the default limit will
; be used.
;CHECK INPUT
S VAQHSPTR=+$G(VAQHSPTR)
Q:('VAQHSPTR) "-1^Did not pass pointer to HEALTH SUMMARY COMPONENT file"
Q:('$D(^GMT(142.1,VAQHSPTR,0))) "-1^Did not pass valid pointer to HEALTH SUMMARY COMPONENT file"
S VAQMAXTIME=$G(VAQMAXTIME)
S VAQMAXOCCUR=$G(VAQMAXOCCUR)
N VAQGMTSN0,VAQNAME,VAQABB,VAQIEN,VAQREC,VAQFDA,VAQERROR,VAQMESSAGE,VAQLINE
;FIND THE EXISTING SEGMENT
;GET COMPONENT NAME & ABBREVIATION
S VAQGMTSN0=$G(^GMT(142.1,VAQHSPTR,0))
S VAQNAME=$P(VAQGMTSN0,U,1)
Q:(VAQNAME="") "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain a name"
S VAQABB=$P(VAQGMTSN0,U,4)
Q:(VAQABB="") "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain an abbreviation"
;CONVERT NAME SO ONLY FIRST CHARACTER OF EVERY WORD IS IN UPPERCASE
S VAQNAME=$$FIRSTUP(VAQNAME)
;FIND EXISTING SEGMENT BY NAME, THEN BY ABBREVIATION, THEN BY POINTER TO
;HEALTH SUMMARY COMPONENT
S VAQIEN=+$O(^VAT(394.71,"B",VAQNAME,0))
I VAQIEN=0 S VAQIEN=+$O(^VAT(394.71,"CAPS",$$UP^XLFSTR(VAQNAME),0))
I VAQIEN=0 S VAQIEN=+$O(^VAT(394.71,"C",VAQABB,0))
I VAQIEN>0,$P($G(^VAT(394.71,VAQIEN,0)),U,4)'=VAQHSPTR S VAQIEN=0
I VAQIEN=0 D
.S VAQREC=0 F S VAQREC=$O(^VAT(394.71,VAQREC)) Q:'+VAQREC!(VAQIEN>0) D
..I $P(^VAT(394.71,VAQREC,0),U,4)=VAQHSPTR S VAQIEN=VAQREC Q
Q:VAQIEN=0 "-1^"_VAQNAME_" was not found in the VAQ - DATA SEGMENT file"
;CHECK FOR NEW NAME & ABBREVIATION
S VAQIEN=VAQIEN_","
I VAQNAME'=$P($G(^VAT(394.71,+VAQIEN,0)),U,1) S VAQFDA(394.71,VAQIEN,.01)=VAQNAME
I VAQABB'=$P($G(^VAT(394.71,+VAQIEN,0)),U,2) S VAQFDA(394.71,VAQIEN,.02)=VAQABB
D LIMITS(VAQHSPTR,.VAQMAXTIME,.VAQMAXOCCUR)
I VAQMAXTIME'=$P($G(^VAT(394.71,+VAQIEN,0)),U,5) S VAQFDA(394.71,VAQIEN,.05)=VAQMAXTIME
I VAQMAXOCCUR'=$P($G(^VAT(394.71,+VAQIEN,0)),U,6) S VAQFDA(394.71,VAQIEN,.06)=VAQMAXOCCUR
I $D(VAQFDA) D Q:$D(VAQERROR) "-1"_U_VAQERROR
.;USE FILEMAN TO UPDATE SEGMENT
.D FILE^DIE("","VAQFDA","VAQERROR")
.I $D(VAQERROR) D
..D MSG^DIALOG("AET",.VAQMESSAGE,,,"VAQERROR")
..F VAQLINE=1:1:VAQMESSAGE D
...S VAQERROR=$S($G(VAQERROR)'="":VAQERROR_" ",1:"")_VAQMESSAGE(VAQLINE)
Q 0
FIRSTUP(TEXT) ;FIRST CHARACTER EVERY WORD UPPER
;INPUT : TEXT - Text string to convert
;OUTPUT : Text - Same text string with beginning of every word
; in uppercase and all other characters in lowercase
;
;CHECK INPUT
Q:($G(TEXT)="") ""
;DECLARE VARIABLES
N OUTTEXT,SPOT,UPCHAR,X,Y,LEN
;CONVERT TO LOWERCASE
S OUTTEXT=$$LOW^XLFSTR(TEXT)
;CAPITALIZE FIRST WORD
S X=$E(OUTTEXT,1)
X ^%ZOSF("UPPERCASE")
S OUTTEXT=Y_$E(OUTTEXT,2,$L(OUTTEXT))
;CAPITALIZE REST OF WORDS
S SPOT=1
S LEN=$L(OUTTEXT)
F S SPOT=$F(OUTTEXT," ",SPOT) Q:('SPOT) D
.S X=$E(OUTTEXT,SPOT)
.X ^%ZOSF("UPPERCASE")
.S OUTTEXT=$E(OUTTEXT,1,(SPOT-1))_Y_$E(OUTTEXT,(SPOT+1),LEN)
Q OUTTEXT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQUTL50 7663 printed Dec 13, 2024@02:26:59 Page 2
VAQUTL50 ;ALB/JRP - CREATE DATA SEGMENT FROM H.S. COMPONENT;Jun 07, 2023@11:47
+1 ;;1.5;PATIENT DATA EXCHANGE;**11,46**;NOV 17, 1993;Build 17
+2 ; Reference to ^GMT(142.1,D0,0) in ICR #814
ADDSEG(HSPTR,MAXTIME,MAXOCCUR) ;ADD NEW DATA SEGMENT USING H.S. COMPONENT
+1 ;INPUT : HSPTR - Pointer to HEALTH SUMMARY COMPONENT file (#142.1)
+2 ; MAXTIME - Max time limit allowed for auto processing
+3 ; MAXOCCUR - Max occurrence limit allowed for auto processing
+4 ;OUTPUT : 0 - VAQ - DATA SEGMENT file (#394.71) entry was successfully
+5 ; created
+6 ; -1^ErrorText - Entry not created
+7 ;NOTES : If time and/or occurrence limits do not apply to the
+8 ; component, MAXTIME and/or MAXOCCUR are not required.
+9 ; : If time and/or occurrence limits apply to the component,
+10 ; default values will be taken from the VAQ - PARAMETER
+11 ; file (#394.81). If parameter file does not contain these
+12 ; values, a default of 1 year and 10 occurrences will be used.
+13 ; : If a maximum limit is not valid, the default limit will
+14 ; be used.
+15 ;
+16 ;CHECK INPUT
+17 SET HSPTR=+$GET(HSPTR)
+18 if ('HSPTR)
QUIT "-1^Did not pass pointer to HEALTH SUMMARY COMPONENT file"
+19 if ('$DATA(^GMT(142.1,HSPTR,0)))
QUIT "-1^Did not pass valid pointer to HEALTH SUMMARY COMPONENT file"
+20 SET MAXTIME=$GET(MAXTIME)
+21 SET MAXOCCUR=$GET(MAXOCCUR)
+22 ;DECLARE VARIABLES
+23 NEW NAME,ABB,TMP
+24 NEW X,Y,DIC,DINUM,DA,DIE,DR
+25 ;GET COMPONENT NAME & ABBREVIATION
+26 SET TMP=$GET(^GMT(142.1,HSPTR,0))
+27 SET NAME=$PIECE(TMP,U,1)
+28 if (NAME="")
QUIT "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain a name"
+29 SET ABB=$PIECE(TMP,U,4)
+30 if (ABB="")
QUIT "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain an abbreviation"
+31 ;CONVERT NAME SO ONLY FIRST CHARACTER OF EVERY WORD IS IN UPPERCASE
+32 SET NAME=$$FIRSTUP(NAME)
+33 ;SEE IF NAME OR ABBREVIATION ALREADY EXIST IN DATA SEGMENT FILE
+34 if ($DATA(^VAT(394.71,"B",NAME)))
QUIT "-1^"_NAME_" already exists in VAQ - DATA SEGMENT file"
+35 if ($DATA(^VAT(394.71,"CAPS",$$UP^XLFSTR(NAME))))
QUIT "-1^"_NAME_" already exists in VAQ - DATA SEGMENT file"
+36 if ($DATA(^VAT(394.71,"C",ABB)))
QUIT "-1^Abbreviation of "_ABB_" already used in VAQ - DATA SEGMENT file"
+37 DO LIMITS(HSPTR,.MAXTIME,.MAXOCCUR)
+38 ;SET UP CALL TO FILEMAN & CREATE STUB
+39 NEW VAQFDA,VAQERROR,VAQMESSAGE
+40 SET VAQFDA(394.71,"+1,",.01)=NAME
+41 SET VAQFDA(394.71,"+1,",.02)=ABB
+42 SET VAQFDA(394.71,"+1,",.03)="YES"
+43 SET VAQFDA(394.71,"+1,",.04)="`"_HSPTR
+44 SET VAQFDA(394.71,"+1,",.05)=MAXTIME
+45 SET VAQFDA(394.71,"+1,",.06)=MAXOCCUR
+46 SET VAQFDA(394.71,"+1,",10)="$$GET^GMTSPDX(TRAN,DFN,SEGPTR,ROOT,(OFFSET-1),TIMLIM,OCCLIM)"
+47 SET VAQFDA(394.71,"+1,",20)="@"
+48 DO UPDATE^DIE("E","VAQFDA",,"VAQERROR")
+49 IF $DATA(VAQERROR)
Begin DoDot:1
+50 DO MSG^DIALOG("AET",.VAQMESSAGE,,,"VAQERROR")
+51 NEW VAQLINE
+52 FOR VAQLINE=1:1:VAQMESSAGE
Begin DoDot:2
+53 SET VAQERROR=$SELECT($GET(VAQERROR)'="":VAQERROR_" ",1:"")_VAQMESSAGE(VAQLINE)
End DoDot:2
End DoDot:1
QUIT "-1"_U_VAQMESSAGE
+54 QUIT 0
LIMITS(VAQHSPTR,VAQMAXTIME,VAQMAXOCCUR) ;DETERMINE MAX TIME/OCCURRENCE LIMITS
+1 ;INPUT: VAQHSPTR - Pointer to HEALTH SUMMARY COMPONENT file (#142.1)
+2 ; VAQMAXTIME - Max time limit allowed for auto processing
+3 ; VQAMAXOCCUR - Max occurrence limit allowed for auto processing
+4 ;GET DEFAULT TIME AND OCCURRENCE LIMITS
+5 NEW VAQIEN,VAQNLIMIT,VAQDEFTIME,VAQDEFOCCUR,VAQLIMIT,VAQTIME,VAQOCCUR
+6 SET VAQIEN=+$ORDER(^VAT(394.81,0))
+7 SET VAQNLIMIT=$GET(^VAT(394.81,VAQIEN,"LIMITS"))
+8 SET VAQDEFTIME=$PIECE(VAQNLIMIT,U,1)
+9 if (VAQDEFTIME="")
SET VAQDEFTIME="1Y"
+10 SET VAQDEFOCCUR=$PIECE(VAQNLIMIT,U,2)
+11 if (VAQDEFOCCUR="")
SET VAQDEFOCCUR=10
+12 ;DETERMINE IF TIME AND/OR OCCURRENCE LIMITS APPLY
+13 SET VAQLIMIT=$$LIMITS^VAQDBIH3(VAQHSPTR)
+14 SET VAQTIME=+VAQLIMIT
SET VAQOCCUR=+$PIECE(VAQLIMIT,U,2)
+15 ;SET MAX LIMITS
+16 IF (VAQTIME)
if ($$VALOCC^VAQDBIH2(VAQMAXTIME,0)<0)
SET VAQMAXTIME=VAQDEFTIME
+17 IF ('VAQTIME)
SET VAQMAXTIME=""
+18 IF (VAQOCCUR)
if ($$VALOCC^VAQDBIH2(VAQMAXOCCUR,1)<0)
SET VAQMAXOCCUR=VAQDEFOCCUR
+19 IF ('VAQOCCUR)
SET VAQMAXOCCUR=""
+20 QUIT
UPDSEG(VAQHSPTR,VAQMAXTIME,VAQMAXOCCUR) ;UPDATE EXISTING DATA SEGMENT USING H.S. COMPONENT
+1 ;INPUT : VAQHSPTR - Pointer to HEALTH SUMMARY COMPONENT file (#142.1)
+2 ; VAQMAXTIME - Max time limit allowed for auto processing
+3 ; VAQMAXOCCUR - Max occurrence limit allowed for auto processing
+4 ;OUTPUT : $$UPDSEG - 0 - VAQ - DATA SEGMENT file (#394.71) entry was successfully
+5 ; updated
+6 ; -1^ErrorText - Entry not updated
+7 ;NOTES : If time and/or occurrence limits do not apply to the
+8 ; component, MAXTIME and/or MAXOCCUR are not required.
+9 ; : If time and/or occurrence limits apply to the component,
+10 ; default values will be taken from the VAQ - PARAMETER
+11 ; file (#394.81). If parameter file does not contain these
+12 ; values, a default of 1 year and 10 occurrences will be used.
+13 ; : If a maximum limit is not valid, the default limit will
+14 ; be used.
+15 ;CHECK INPUT
+16 SET VAQHSPTR=+$GET(VAQHSPTR)
+17 if ('VAQHSPTR)
QUIT "-1^Did not pass pointer to HEALTH SUMMARY COMPONENT file"
+18 if ('$DATA(^GMT(142.1,VAQHSPTR,0)))
QUIT "-1^Did not pass valid pointer to HEALTH SUMMARY COMPONENT file"
+19 SET VAQMAXTIME=$GET(VAQMAXTIME)
+20 SET VAQMAXOCCUR=$GET(VAQMAXOCCUR)
+21 NEW VAQGMTSN0,VAQNAME,VAQABB,VAQIEN,VAQREC,VAQFDA,VAQERROR,VAQMESSAGE,VAQLINE
+22 ;FIND THE EXISTING SEGMENT
+23 ;GET COMPONENT NAME & ABBREVIATION
+24 SET VAQGMTSN0=$GET(^GMT(142.1,VAQHSPTR,0))
+25 SET VAQNAME=$PIECE(VAQGMTSN0,U,1)
+26 if (VAQNAME="")
QUIT "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain a name"
+27 SET VAQABB=$PIECE(VAQGMTSN0,U,4)
+28 if (VAQABB="")
QUIT "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain an abbreviation"
+29 ;CONVERT NAME SO ONLY FIRST CHARACTER OF EVERY WORD IS IN UPPERCASE
+30 SET VAQNAME=$$FIRSTUP(VAQNAME)
+31 ;FIND EXISTING SEGMENT BY NAME, THEN BY ABBREVIATION, THEN BY POINTER TO
+32 ;HEALTH SUMMARY COMPONENT
+33 SET VAQIEN=+$ORDER(^VAT(394.71,"B",VAQNAME,0))
+34 IF VAQIEN=0
SET VAQIEN=+$ORDER(^VAT(394.71,"CAPS",$$UP^XLFSTR(VAQNAME),0))
+35 IF VAQIEN=0
SET VAQIEN=+$ORDER(^VAT(394.71,"C",VAQABB,0))
+36 IF VAQIEN>0
IF $PIECE($GET(^VAT(394.71,VAQIEN,0)),U,4)'=VAQHSPTR
SET VAQIEN=0
+37 IF VAQIEN=0
Begin DoDot:1
+38 SET VAQREC=0
FOR
SET VAQREC=$ORDER(^VAT(394.71,VAQREC))
if '+VAQREC!(VAQIEN>0)
QUIT
Begin DoDot:2
+39 IF $PIECE(^VAT(394.71,VAQREC,0),U,4)=VAQHSPTR
SET VAQIEN=VAQREC
QUIT
End DoDot:2
End DoDot:1
+40 if VAQIEN=0
QUIT "-1^"_VAQNAME_" was not found in the VAQ - DATA SEGMENT file"
+41 ;CHECK FOR NEW NAME & ABBREVIATION
+42 SET VAQIEN=VAQIEN_","
+43 IF VAQNAME'=$PIECE($GET(^VAT(394.71,+VAQIEN,0)),U,1)
SET VAQFDA(394.71,VAQIEN,.01)=VAQNAME
+44 IF VAQABB'=$PIECE($GET(^VAT(394.71,+VAQIEN,0)),U,2)
SET VAQFDA(394.71,VAQIEN,.02)=VAQABB
+45 DO LIMITS(VAQHSPTR,.VAQMAXTIME,.VAQMAXOCCUR)
+46 IF VAQMAXTIME'=$PIECE($GET(^VAT(394.71,+VAQIEN,0)),U,5)
SET VAQFDA(394.71,VAQIEN,.05)=VAQMAXTIME
+47 IF VAQMAXOCCUR'=$PIECE($GET(^VAT(394.71,+VAQIEN,0)),U,6)
SET VAQFDA(394.71,VAQIEN,.06)=VAQMAXOCCUR
+48 IF $DATA(VAQFDA)
Begin DoDot:1
+49 ;USE FILEMAN TO UPDATE SEGMENT
+50 DO FILE^DIE("","VAQFDA","VAQERROR")
+51 IF $DATA(VAQERROR)
Begin DoDot:2
+52 DO MSG^DIALOG("AET",.VAQMESSAGE,,,"VAQERROR")
+53 FOR VAQLINE=1:1:VAQMESSAGE
Begin DoDot:3
+54 SET VAQERROR=$SELECT($GET(VAQERROR)'="":VAQERROR_" ",1:"")_VAQMESSAGE(VAQLINE)
End DoDot:3
End DoDot:2
End DoDot:1
if $DATA(VAQERROR)
QUIT "-1"_U_VAQERROR
+55 QUIT 0
FIRSTUP(TEXT) ;FIRST CHARACTER EVERY WORD UPPER
+1 ;INPUT : TEXT - Text string to convert
+2 ;OUTPUT : Text - Same text string with beginning of every word
+3 ; in uppercase and all other characters in lowercase
+4 ;
+5 ;CHECK INPUT
+6 if ($GET(TEXT)="")
QUIT ""
+7 ;DECLARE VARIABLES
+8 NEW OUTTEXT,SPOT,UPCHAR,X,Y,LEN
+9 ;CONVERT TO LOWERCASE
+10 SET OUTTEXT=$$LOW^XLFSTR(TEXT)
+11 ;CAPITALIZE FIRST WORD
+12 SET X=$EXTRACT(OUTTEXT,1)
+13 XECUTE ^%ZOSF("UPPERCASE")
+14 SET OUTTEXT=Y_$EXTRACT(OUTTEXT,2,$LENGTH(OUTTEXT))
+15 ;CAPITALIZE REST OF WORDS
+16 SET SPOT=1
+17 SET LEN=$LENGTH(OUTTEXT)
+18 FOR
SET SPOT=$FIND(OUTTEXT," ",SPOT)
if ('SPOT)
QUIT
Begin DoDot:1
+19 SET X=$EXTRACT(OUTTEXT,SPOT)
+20 XECUTE ^%ZOSF("UPPERCASE")
+21 SET OUTTEXT=$EXTRACT(OUTTEXT,1,(SPOT-1))_Y_$EXTRACT(OUTTEXT,(SPOT+1),LEN)
End DoDot:1
+22 QUIT OUTTEXT
