VAQPST50 ;ALB/JRP - CREATE DATA SEGMENT FROM H.S. COMPONENT;28-APR-94
;;1.5;PATIENT DATA EXCHANGE;**4**;NOV 17, 1993
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 : X - Pointer to VAQ - DATA SEGMENT file (#394.71) that
; was 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,TIME,OCCUR,TMP,DEFTIME,DEFOCCUR
N X,Y,DIC,DINUM,DA,DIE,DR
;GET COMPONENT NAME & ABBREVIATION
S TMP=$G(^GMT(142.1,HSPTR,0))
S NAME=$P(TMP,"^",1)
Q:(NAME="") "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain a name"
S ABB=$P(TMP,"^",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",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"
;GET DEFAULT TIME AND OCCURRENCE LIMITS
S X=+$O(^VAT(394.81,0))
S TMP=$G(^VAT(394.81,X,"LIMITS"))
S DEFTIME=$P(TMP,"^",1)
S:(DEFTIME="") DEFTIME="1Y"
S DEFOCCUR=$P(TMP,"^",2)
S:(DEFOCCUR="") DEFOCCUR=10
;DETERMINE IF TIME AND/OR OCCURRENCE LIMITS APPLY
S TMP=$$LIMITS^VAQDBIH3(HSPTR)
S TIME=+TMP
S OCCUR=+$P(TMP,"^",2)
;SET MAX LIMITS
I (TIME) S:($$VALOCC^VAQDBIH2(MAXTIME,0)<0) MAXTIME=DEFTIME
I ('TIME) S MAXTIME=""
I (OCCUR) S:($$VALOCC^VAQDBIH2(MAXOCCUR,1)<0) MAXOCCUR=DEFOCCUR
I ('OCCUR) S MAXOCCUR=""
;SET UP CALL TO FILEMAN & CREATE STUB
K DD,DO
S DIC="^VAT(394.71,"
S DIC(0)="L"
S X=NAME
D FILE^DICN
S DA=+Y
Q:(DA<0) "-1^Unable to create entry in VAQ - DATA SEGMENT file"
;SET UP CALL TO FILEMAN & FINISH ENTRY
S DIE="^VAT(394.71,"
S DR=".02///^S X=ABB"
S DR(1,394.71,.03)=".03///YES"
S DR(1,394.71,.04)=".04////"_HSPTR
S DR(1,394.71,.05)=".05///^S X=MAXTIME"
S DR(1,394.71,.06)=".06///^S X=MAXOCCUR"
S DR(1,394.71,10)="10///$$GET^GMTSPDX(TRAN,DFN,SEGPTR,ROOT,(OFFSET-1),TIMLIM,OCCLIM)"
S DR(1,394.71,20)="20///@"
D ^DIE
Q 0
LOWER(STRING) ;CONVERT UPPERCASE TO LOWERCASE
;INPUT : STRING - Text string to convert
;OUTPUT : string - Same text string in all lowercase
;
Q $TR($G(STRING),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
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=$$LOWER(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[HVAQPST50 4151 printed Dec 13, 2024@02:26:37 Page 2
VAQPST50 ;ALB/JRP - CREATE DATA SEGMENT FROM H.S. COMPONENT;28-APR-94
+1 ;;1.5;PATIENT DATA EXCHANGE;**4**;NOV 17, 1993
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 : X - Pointer to VAQ - DATA SEGMENT file (#394.71) that
+5 ; was 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,TIME,OCCUR,TMP,DEFTIME,DEFOCCUR
+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,"^",1)
+28 if (NAME="")
QUIT "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain a name"
+29 SET ABB=$PIECE(TMP,"^",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",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 ;GET DEFAULT TIME AND OCCURRENCE LIMITS
+38 SET X=+$ORDER(^VAT(394.81,0))
+39 SET TMP=$GET(^VAT(394.81,X,"LIMITS"))
+40 SET DEFTIME=$PIECE(TMP,"^",1)
+41 if (DEFTIME="")
SET DEFTIME="1Y"
+42 SET DEFOCCUR=$PIECE(TMP,"^",2)
+43 if (DEFOCCUR="")
SET DEFOCCUR=10
+44 ;DETERMINE IF TIME AND/OR OCCURRENCE LIMITS APPLY
+45 SET TMP=$$LIMITS^VAQDBIH3(HSPTR)
+46 SET TIME=+TMP
+47 SET OCCUR=+$PIECE(TMP,"^",2)
+48 ;SET MAX LIMITS
+49 IF (TIME)
if ($$VALOCC^VAQDBIH2(MAXTIME,0)<0)
SET MAXTIME=DEFTIME
+50 IF ('TIME)
SET MAXTIME=""
+51 IF (OCCUR)
if ($$VALOCC^VAQDBIH2(MAXOCCUR,1)<0)
SET MAXOCCUR=DEFOCCUR
+52 IF ('OCCUR)
SET MAXOCCUR=""
+53 ;SET UP CALL TO FILEMAN & CREATE STUB
+54 KILL DD,DO
+55 SET DIC="^VAT(394.71,"
+56 SET DIC(0)="L"
+57 SET X=NAME
+58 DO FILE^DICN
+59 SET DA=+Y
+60 if (DA<0)
QUIT "-1^Unable to create entry in VAQ - DATA SEGMENT file"
+61 ;SET UP CALL TO FILEMAN & FINISH ENTRY
+62 SET DIE="^VAT(394.71,"
+63 SET DR=".02///^S X=ABB"
+64 SET DR(1,394.71,.03)=".03///YES"
+65 SET DR(1,394.71,.04)=".04////"_HSPTR
+66 SET DR(1,394.71,.05)=".05///^S X=MAXTIME"
+67 SET DR(1,394.71,.06)=".06///^S X=MAXOCCUR"
+68 SET DR(1,394.71,10)="10///$$GET^GMTSPDX(TRAN,DFN,SEGPTR,ROOT,(OFFSET-1),TIMLIM,OCCLIM)"
+69 SET DR(1,394.71,20)="20///@"
+70 DO ^DIE
+71 QUIT 0
LOWER(STRING) ;CONVERT UPPERCASE TO LOWERCASE
+1 ;INPUT : STRING - Text string to convert
+2 ;OUTPUT : string - Same text string in all lowercase
+3 ;
+4 QUIT $TRANSLATE($GET(STRING),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
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=$$LOWER(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
