| 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
 | 
|---|