source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPDXZ.m@ 1765

Last change on this file since 1765 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1GMTSPDXZ ;SLC/NCG - Create Data Segment from H.S. Component ;26-OCT-94 ;1/4/95 09:22
2 ;;2.7;Health Summary;;Oct 20, 1995
3VAQUTL50 ;ALB/JRP - CREATE DATA SEGMENT FROM H.S. COMPONENT ;26-OCT-94
4 ;;1.5;PATIENT DATA EXCHANGE;**11**;NOV 17, 1993
5ADDSEG(HSPTR,MAXTIME,MAXOCCUR) ;ADD NEW DATA SEGMENT USING H.S. COMPONENT
6 ;INPUT : HSPTR - Pointer to HEALTH SUMMARY COMPONENT file (#142.1)
7 ; MAXTIME - Max time limit allowed for auto processing
8 ; MAXOCCUR - Max occurrence limit allowed for auto processing
9 ;OUTPUT : X - Pointer to VAQ - DATA SEGMENT file (#394.71) that
10 ; was created
11 ; -1^ErrorText - Entry not created
12 ;NOTES : If time and/or occurrence limits do not apply to the
13 ; component, MAXTIME and/or MAXOCCUR are not required.
14 ; : If time and/or occurrence limits apply to the component,
15 ; default values will be taken from the VAQ - PARAMETER
16 ; file (#394.81). If parameter file does not contain these
17 ; values, a default of 1 year and 10 occurrences will be used.
18 ; : If a maximum limit is not valid, the default limit will
19 ; be used.
20 ;
21 ;CHECK INPUT
22 S HSPTR=+$G(HSPTR)
23 Q:('HSPTR) "-1^Did not pass pointer to HEALTH SUMMARY COMPONENT file"
24 Q:('$D(^GMT(142.1,HSPTR,0))) "-1^Did not pass valid pointer to HEALTH SUMMARY COMPONENT file"
25 S MAXTIME=$G(MAXTIME)
26 S MAXOCCUR=$G(MAXOCCUR)
27 ;DECLARE VARIABLES
28 N NAME,ABB,TIME,OCCUR,TMP,DEFTIME,DEFOCCUR
29 N X,Y,DIC,DINUM,DA,DIE,DR
30 ;GET COMPONENT NAME & ABBREVIATION
31 S TMP=$G(^GMT(142.1,HSPTR,0))
32 S NAME=$P(TMP,"^",1)
33 Q:(NAME="") "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain a name"
34 S ABB=$P(TMP,"^",4)
35 Q:(ABB="") "-1^Entry in HEALTH SUMMARY COMPONENT file did not contain an abbreviation"
36 ;CONVERT NAME SO ONLY FIRST CHARACTER OF EVERY WORD IS IN UPPERCASE
37 S NAME=$$FIRSTUP(NAME)
38 ;SEE IF NAME OR ABBREVIATION ALREADY EXIST IN DATA SEGMENT FILE
39 Q:($D(^VAT(394.71,"B",NAME))) "-1^"_NAME_" already exists in VAQ - DATA SEGMENT file"
40 Q:($D(^VAT(394.71,"CAPS",NAME))) "-1^"_NAME_" already exists in VAQ - DATA SEGMENT file"
41 Q:($D(^VAT(394.71,"C",ABB))) "-1^Abbreviation of "_ABB_" already used in VAQ - DATA SEGMENT file"
42 ;GET DEFAULT TIME AND OCCURRENCE LIMITS
43 S X=+$O(^VAT(394.81,0))
44 S TMP=$G(^VAT(394.81,X,"LIMITS"))
45 S DEFTIME=$P(TMP,"^",1)
46 S:(DEFTIME="") DEFTIME="1Y"
47 S DEFOCCUR=$P(TMP,"^",2)
48 S:(DEFOCCUR="") DEFOCCUR=10
49 ;DETERMINE IF TIME AND/OR OCCURRENCE LIMITS APPLY
50 S TMP=$$LIMITS^VAQDBIH3(HSPTR)
51 S TIME=+TMP
52 S OCCUR=+$P(TMP,"^",2)
53 ;SET MAX LIMITS
54 I (TIME) S:($$VALOCC^VAQDBIH2(MAXTIME,0)<0) MAXTIME=DEFTIME
55 I ('TIME) S MAXTIME=""
56 I (OCCUR) S:($$VALOCC^VAQDBIH2(MAXOCCUR,1)<0) MAXOCCUR=DEFOCCUR
57 I ('OCCUR) S MAXOCCUR=""
58 ;SET UP CALL TO FILEMAN & CREATE STUB
59 K DD,DO
60 S DIC="^VAT(394.71,"
61 S DIC(0)="L"
62 S X=NAME
63 D FILE^DICN
64 S DA=+Y
65 Q:(DA<0) "-1^Unable to create entry in VAQ - DATA SEGMENT file"
66 ;SET UP CALL TO FILEMAN & FINISH ENTRY
67 S DIE="^VAT(394.71,"
68 S DR=".02///^S X=ABB"
69 S DR(1,394.71,.03)=".03///YES"
70 S DR(1,394.71,.04)=".04////"_HSPTR
71 S DR(1,394.71,.05)=".05///^S X=MAXTIME"
72 S DR(1,394.71,.06)=".06///^S X=MAXOCCUR"
73 S DR(1,394.71,10)="10///$$GET^GMTSPDX(TRAN,DFN,SEGPTR,ROOT,(OFFSET-1),TIMLIM,OCCLIM)"
74 S DR(1,394.71,20)="20///@"
75 D ^DIE
76 Q 0
77LOWER(STRING) ;CONVERT UPPERCASE TO LOWERCASE
78 ;INPUT : STRING - Text string to convert
79 ;OUTPUT : string - Same text string in all lowercase
80 ;
81 Q $TR($G(STRING),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
82FIRSTUP(TEXT) ;FIRST CHARACTER EVERY WORD UPPER
83 ;INPUT : TEXT - Text string to convert
84 ;OUTPUT : Text - Same text string with beginning of every word
85 ; in uppercase and all other characters in lowercase
86 ;
87 ;CHECK INPUT
88 Q:($G(TEXT)="") ""
89 ;DECLARE VARIABLES
90 N OUTTEXT,SPOT,UPCHAR,X,Y,LEN
91 ;CONVERT TO LOWERCASE
92 S OUTTEXT=$$LOWER(TEXT)
93 ;CAPITALIZE FIRST WORD
94 S X=$E(OUTTEXT,1)
95 X ^%ZOSF("UPPERCASE")
96 S OUTTEXT=Y_$E(OUTTEXT,2,$L(OUTTEXT))
97 ;CAPITALIZE REST OF WORDS
98 S SPOT=1
99 S LEN=$L(OUTTEXT)
100 F S SPOT=$F(OUTTEXT," ",SPOT) Q:('SPOT) D
101 .S X=$E(OUTTEXT,SPOT)
102 .X ^%ZOSF("UPPERCASE")
103 .S OUTTEXT=$E(OUTTEXT,1,(SPOT-1))_Y_$E(OUTTEXT,(SPOT+1),LEN)
104 Q OUTTEXT
Note: See TracBrowser for help on using the repository browser.