1 | OOPSUTL3 ;HINES/WAA-Utilities Routines ;3/24/98
|
---|
2 | ;;2.0;ASISTS;;Jun 03, 2002
|
---|
3 | ;;
|
---|
4 | CHECK(IEN,FORM) ; Checks to see if there was data enter for a form
|
---|
5 | N ANS,I,LIST,FIELD
|
---|
6 | S ANS=0
|
---|
7 | I FORM="CA1" S LIST="130,176,138,139,140,175,146,148,150,156,157,158,159,160,161,162,163"
|
---|
8 | ; Patch 8 - removed field 250 from list below
|
---|
9 | I FORM="CA2" S LIST="230,237,242,243,244,245,246,247,248,249,251,252,258"
|
---|
10 | F I=1:1 S FIELD=$P(LIST,",",I) Q:FIELD="" D Q:ANS
|
---|
11 | .I $$GET1^DIQ(2260,IEN,FIELD,"I")'="" S ANS=1
|
---|
12 | .Q
|
---|
13 | Q ANS
|
---|
14 | PSDTCHK(DATE,NOYR,FLD) ;
|
---|
15 | ; this functionality returns a valid date (the one passed in) if
|
---|
16 | ; the current date (DT) minus the date passed in (DATE) is less than
|
---|
17 | ; the value in NOYR. Specific checking also occurs if date pasted in
|
---|
18 | ; is the DOB (field 6).
|
---|
19 | ;
|
---|
20 | ; Note: DT must be defined to run
|
---|
21 | ; Input: DATE = external value of the date entered by user
|
---|
22 | ; NOYR = # of years in past to check date entered in against
|
---|
23 | ; FLD = field number of the field
|
---|
24 | ; Output: VAL = DATE passed in if valid (true)
|
---|
25 | ; "" if not valid
|
---|
26 | N VAL
|
---|
27 | S VAL=DATE
|
---|
28 | I '$G(IEN) S IEN=$G(DA)
|
---|
29 | I DATE>0,(($E(DT,1,3)-$E(DATE,1,3))>NOYR) S VAL="" D
|
---|
30 | . W !!?5,$$GET1^DID(2260,FLD,"","LABEL")_" cannot be more than "_NOYR_" years in the past.",!
|
---|
31 | I VAL,IEN,FLD=6,$$GET1^DIQ(2260,IEN,4,"I") D
|
---|
32 | . I DATE>$$GET1^DIQ(2260,IEN,4,"I") S VAL="" W !!?5,"DOB cannot be after "_$$GET1^DID(2260,4,"","LABEL"),!
|
---|
33 | Q VAL
|
---|
34 | NMCHK(NA) ; Checks format for name fields
|
---|
35 | ;
|
---|
36 | ; Input - NA = value entered (X) for name
|
---|
37 | ; Output - VALID = 1 if format valid
|
---|
38 | ; 0 if format not valid
|
---|
39 | ;
|
---|
40 | N VALID,LN
|
---|
41 | S VALID=1
|
---|
42 | I (NA?1P.E)!(NA'?1U.ANP)!(NA'[",") S VALID=0
|
---|
43 | I $TR(NA,"~`!@#$%^&*()_+=|}{[]\:;'?><./","")'=NA S VALID=0
|
---|
44 | S LN=$P(NA,",") I (LN[" ")!($L(LN)=0) S VALID=0
|
---|
45 | I $P(NA,",",2)="" S VALID=0
|
---|
46 | Q VALID
|
---|
47 | NMERR ; Error message to print if error on name check and doing input
|
---|
48 | W !,"Enter the person's name, using the format LASTNAME,FIRSTNAME."
|
---|
49 | W !,"Suffixes such as Sr, Jr, III can only be entered as a FIRSTNAME."
|
---|
50 | W !,"There must be a LAST NAME and FIRST NAME separated by a comma."
|
---|
51 | W !,"Spaces in the last name are not allowed and the only "
|
---|
52 | W !,"punctuation allowed is a hyphen (-) or comma (,).",!
|
---|
53 | Q
|
---|
54 | WIT() ; Check if Witness name exists that other witness fields have data
|
---|
55 | ;
|
---|
56 | N ARR,I,J,LAST,STR,VALID,WIT,VCHAR
|
---|
57 | S VALID=1,VCHAR=1
|
---|
58 | S WIT=$O(^OOPS(2260,IEN,"CA1W",0))
|
---|
59 | I '$G(WIT) Q VALID
|
---|
60 | S LAST=$P($G(^OOPS(2260,IEN,"CA1W",0)),U,3)
|
---|
61 | F I=WIT:1:LAST I $G(^OOPS(2260,IEN,"CA1W",I,0))'="" D
|
---|
62 | . S STR=^OOPS(2260,IEN,"CA1W",I,0)
|
---|
63 | . F J=2:1:6 I $P($G(STR),U,J)="" S VALID=0,ARR($P(STR,U,1),J)=""
|
---|
64 | . F J=2:1:3 I $P($G(STR),U,J)'=$TR($P($G(STR),U,J),"~`@#$%^*_|\}{[]><","") S VCHAR=0
|
---|
65 | . I $P($G(STR),U,6) D
|
---|
66 | .. I ($$GET1^DIQ(2260,IEN,4,"I")\1)>$P(STR,U,6) S VALID=0
|
---|
67 | I 'VALID,$D(ARR) D
|
---|
68 | . W !," Witness Data is incomplete for the following Witnesses, enter missing data."
|
---|
69 | . S I="" F S I=$O(ARR(I)) Q:I="" W !?7,I," is missing the" D
|
---|
70 | .. S J="" F S J=$O(ARR(I,J)) Q:J="" W !?9,$$GET1^DID(2260.0125,J-1,"","LABEL")
|
---|
71 | I 'VALID D
|
---|
72 | . I $P(STR,U,6) W !," Date of Witness Signature cannot be prior to DATE/TIME OF OCCURRENCE."
|
---|
73 | I 'VCHAR W !," Address or City contains invalid characters:",!?7,"(~,`,@,#,$,%,*,_,|,\,},{,[,],>,or <). Please Edit"
|
---|
74 | Q VALID_U_VCHAR
|
---|
75 | REG(IEN,FIELD) ; Regular work schedule
|
---|
76 | N DIR,Y
|
---|
77 | N ANS,ANSS,LINE
|
---|
78 | S (ANSS,ANS)=""
|
---|
79 | I FIELD=140 S ANSS=$P($G(^OOPS(2260,IEN,"CA1F")),U,11)
|
---|
80 | I FIELD=244 S ANSS=$P($G(^OOPS(2260,IEN,"CA2I")),U,8)
|
---|
81 | I ANSS'="" D
|
---|
82 | .W !," YOU LAST SELECTED: "
|
---|
83 | .N I,DAY
|
---|
84 | .F I=1:1 S DAY=$P(ANSS,",",I) Q:DAY="" D
|
---|
85 | .. I DAY=1 W !," 1) SUNDAY"
|
---|
86 | .. I DAY=2 W !," 2) MONDAY"
|
---|
87 | .. I DAY=3 W !," 3) TUESDAY"
|
---|
88 | .. I DAY=4 W !," 4) WEDNESDAY"
|
---|
89 | .. I DAY=5 W !," 5) THURSDAY"
|
---|
90 | .. I DAY=6 W !," 6) FRIDAY"
|
---|
91 | .. I DAY=7 W !," 7) SATURDAY"
|
---|
92 | ..Q
|
---|
93 | .W !
|
---|
94 | .Q
|
---|
95 | W !
|
---|
96 | S LINE=" "_$S(FIELD=140:"20",FIELD=244:"22",1:"")_". REGULAR WORK SCHEDULE:"
|
---|
97 | W !,LINE
|
---|
98 | W !," 1) SUNDAY"
|
---|
99 | W !," 2) MONDAY"
|
---|
100 | W !," 3) TUESDAY"
|
---|
101 | W !," 4) WEDNESDAY"
|
---|
102 | W !," 5) THURSDAY"
|
---|
103 | W !," 6) FRIDAY"
|
---|
104 | W !," 7) SATURDAY"
|
---|
105 | W !
|
---|
106 | S DIR(0)="LAO^1:7"
|
---|
107 | S DIR("A")="SELECT THE DAYS OF THE WEEK: "
|
---|
108 | S DIR("?")="This response must be a list or range, e.g., 1,3,5 or 2-4,8."
|
---|
109 | S DIR("?",1)="ENTER THE NUMBER OF THE DAY/S OF THE WEEK WORKED"
|
---|
110 | S DIR("?",2)=" 1-3,6,7 WOULD BE: "
|
---|
111 | S DIR("?",3)=" SUNDAY THRU TUESDAY, FRIDAY AND SATURDAY."
|
---|
112 | D ^DIR
|
---|
113 | I $D(Y(0)) D
|
---|
114 | .S ANS=Y
|
---|
115 | .I FIELD=140 S $P(^OOPS(2260,IEN,"CA1F"),U,11)=ANS
|
---|
116 | .I FIELD=244 S $P(^OOPS(2260,IEN,"CA2I"),U,8)=ANS
|
---|
117 | .Q
|
---|
118 | Q
|
---|
119 | TI ;TIME INPUT TRANS FORM
|
---|
120 | S X=$TR(X,"adimnop","ADIMNOP")
|
---|
121 | I X?1"12".A S X=$S(X="12M":"MID",X="12N":"NOON",1:X)
|
---|
122 | I X?1.A S X=$S(X["MID":2400,X["NOON":1200,1:"")
|
---|
123 | S:$E(X,$L(X))="M" X=$E(X,1,$L(X)-1) S X1=$E(X,$L(X)) I X1?1U,"AP"'[X1 G ERR
|
---|
124 | S X1=$P(X,":",2) I X1'="",X1'?2N1.2U G ERR
|
---|
125 | I X'?4N,$S($L(+X)<3:+X,1:+X\100)>12 G ERR
|
---|
126 | S X=$P(X,":",1)_$P(X,":",2),X1=X
|
---|
127 | G:X?4N A I X'?1.4N1.2U G ERR
|
---|
128 | S:X<13 X=X*100 I X1["A" G:X>1259 ERR S X=$S(X=1200:2400,X>1159:X-1200,1:X)
|
---|
129 | E I X<1200,X1["P"!(X<600) S X=X+1200 I X<1300 G ERR
|
---|
130 | A I X>2400!('X&(X'="0000"))!(X#100>59) G ERR
|
---|
131 | S X1=+X I 'X1!(X1=1200)!(X1=2400) S X=$S(X1=1200:"NOON",1:"MID") G DNE
|
---|
132 | S X1=$S(X1>1259:X1-1200,1:X1),X1=$E("000",0,4-$L(X1))_X1_$S(X=2400:"A",X>1159:"P",1:"A")
|
---|
133 | I "00^15^30^45"'[$E(X1,3,4) G ERR
|
---|
134 | S X=$E(X1,1,2)_":"_$E(X1,3,5)
|
---|
135 | DNE K X1 Q
|
---|
136 | ERR K X,X1 Q
|
---|
137 | CNV ; Convert Start/Stop to minutes
|
---|
138 | ; X=start_"^"_stop Output: Y=start(min)_"^"_stop(min)
|
---|
139 | S CNX=X,X=$P(CNX,"^",1),Y=0 D MIL S Y=Y\100*60+(Y#100),$P(CNX,"^",1)=Y
|
---|
140 | S X=$P(CNX,"^",2),Y=1 D MIL S Y=Y\100*60+(Y#100)
|
---|
141 | S Y=$P(CNX,"^",1)_"^"_Y K CNX Q
|
---|
142 | MIL ; Convert from AM/PM to 2400
|
---|
143 | ; X=time Y: 0=Mid=0,1=Mid=2400 Output: Y=time in 2400
|
---|
144 | I X="MID"!(X="NOON") S Y=$S(X="NOON":1200,Y:2400,1:0) Q
|
---|
145 | S Y=$P(X,":",1)_$P(X,":",2),Y=+Y Q:X["A"
|
---|
146 | S:Y<1200 Y=Y+1200 Q
|
---|
147 | HLP ; Time Help
|
---|
148 | W !?5,"Time may be entered as 8A or 8a, 8:00A, 8:15A, 8:15AM or military"
|
---|
149 | W !?5,"time: 0800, 1300; or MID or 12M for midnight; NOON or 12N for noon."
|
---|
150 | W !?5,"Time must be in quarter hours; e.g., 8A or 8:15A or 8:30A or 8:45A.",!
|
---|
151 | Q
|
---|
152 | DC(OPDT) ; Convert Date to YYYYMMDD
|
---|
153 | ;
|
---|
154 | ; Input: OPDT = Date to be converted
|
---|
155 | ; Output: COPDT = Converted Date
|
---|
156 | S COPDT=""
|
---|
157 | S:OPDT]"" COPDT=OPDT+17000000\1
|
---|
158 | Q COPDT
|
---|
159 | HM(TIME) ;Convert Regular Hrs. From Time and Regular Hrs To Time
|
---|
160 | ; to HHMM (HOUR AND MINUTE)
|
---|
161 | ;
|
---|
162 | ; Input: TIME = Time converted to military time(21:00P), Noon and Mid
|
---|
163 | ; Output: OTIME= Formatted time in HHMM
|
---|
164 | ;
|
---|
165 | S OTIME=$S(TIME="MID":2400,TIME="NOON":1200,1:TIME)
|
---|
166 | I $E(TIME,$L(TIME))="A" S OTIME=$TR($E(TIME,1,5),":")
|
---|
167 | I $E(TIME,$L(TIME))="P" D
|
---|
168 | . S OTIME=$TR($E(TIME,1,5),":")
|
---|
169 | . I OTIME<1200 S OTIME=OTIME+1200
|
---|
170 | Q OTIME
|
---|