103 lines
4.0 KiB
Mathematica
103 lines
4.0 KiB
Mathematica
VAQUTL50 ;ALB/JRP - CREATE DATA SEGMENT FROM H.S. COMPONENT;26-OCT-94
|
|
;;1.5;PATIENT DATA EXCHANGE;**11**;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
|