ENARX201 ;(WASH ISC)/SAW/DH-2162 Archive ;2.23.98
;;7.0;ENGINEERING;**48**;Aug 17, 1993
F I=1:1 S X=$T(Q+I) Q:X="" S Y=$P(X,"=",2,99),X=$P($E(X,4,99),"=",1) S:X="" X=$P(Y,"=",1),Y=%_$P(Y,"=",2,99) X NO E S @X=Y
Q Q
;;^DIC(6919.2,0,"DD")=@
;;^DIC(6919.2,0,"GL")=^ENAR(6919.2,
;;^DIC(6919.2,0,"WR")=@
;;^DIC("B","2162 ACCIDENT ARCHIVE",6919.2)=
;;^DD(6919.2,0)=FIELD^^57.5^62
;;^DD(6919.2,0,"IX","B",6919.2,.01)=
;;^DD(6919.2,0,"NM","2162 ACCIDENT ARCHIVE")=
;;^DD(6919.2,.01,0)=LOCAL ENGINEERING #^RF^^0;1^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>12!($L(X)<6)!(X'?.ANP) X
;;^DD(6919.2,.01,1,0)=^.1
;;^DD(6919.2,.01,1,1,0)=6919.2^B
;;^DD(6919.2,.01,1,1,1)=S ^ENAR(6919.2,"B",$E(X,1,30),DA)=""
;;^DD(6919.2,.01,1,1,2)=K ^ENAR(6919.2,"B",$E(X,1,30),DA)
;;^DD(6919.2,.01,3)=8 digits (YYYYNNNN), where YYYY => Fiscal Year.
;;^DD(6919.2,1,0)=CASE NUMBER^F^^0;2^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>4!($L(X)<4)!'(X?4N) X
;;^DD(6919.2,1,1,0)=^.1^^0
;;^DD(6919.2,1,3)=ANSWER MUST BE 4 DIGITS IN LENGTH
;;^DD(6919.2,1,"DT")=2860915
;;^DD(6919.2,2,0)=REPORT TYPE^S^I:INITIAL;S:SUPPLEMENTAL;C:CORRECTED;^0;3^Q
;;^DD(6919.2,3,0)=RESULT^S^P:PROPERTY ONLY;I:INJURY or ILLNESS;B:BOTH;^0;4^Q
;;^DD(6919.2,4,0)=ACCIDENT CLASS^S^A:MOTOR VEHICLE;B:LABORATORY;C:OFFICE;G:ASSEMBLY;J:PATIENT CARE;L:STORAGE;M:GROUNDS;N:DIETETICS;Z:OTHER;^0;5^Q
;;^DD(6919.2,5,0)=OCCURRENCE DATE^D^^0;6^S %DT="EX" D ^%DT S X=Y K:3000000<X!(2800000>X) X
;;^DD(6919.2,5,3)=TYPE A DATE BETWEEN 1980 AND 2000
;;^DD(6919.2,6,0)=OCCURRENCE TIME^F^^0;7^K:$L(X)>4!($L(X)<4)!'(X?4N) X
;;^DD(6919.2,6,3)=ENTER MILITARY TIME (0000-2400 HRS.)
;;^DD(6919.2,7,0)=SITE^S^A:ON REPORTING ACTIVITY PROPERTY;B:OFF REPORTING ACTIVITY PROPERTY;^0;8^Q
;;^DD(6919.2,7.5,0)=SPECIFIC LOCATION^F^^0;9^K:$L(X)>25!($L(X)<4) X
;;^DD(6919.2,7.5,3)=ANSWER MUST BE 4-25 CHARACTERS IN LENGTH
;;^DD(6919.2,8,0)=TORT CLAIM^S^Y:YES, IS POSSIBLE;N:NO, NOT POSSIBLE;^0;10^Q
;;^DD(6919.2,9,0)=LAST NAME OF INVOLVED^F^^1;1^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>16!($L(X)<3)!'(X'?.C) X
;;^DD(6919.2,9,1,0)=^.1^^0
;;^DD(6919.2,9,3)=ANSWER MUST BE LAST NAME, 3-16 CHARACTERS IN LENGTH
;;^DD(6919.2,9,"DT")=2860915
;;^DD(6919.2,10,0)=FIRST/MIDDLE INITIALS^F^^1;2^K:$L(X)>2!($L(X)<1)!'(X?.A) X
;;^DD(6919.2,10,3)=ANSWER MUST BE 1-2 CHARACTERS IN LENGTH
;;^DD(6919.2,11,0)=SSN^FO^^1;3^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>10!($L(X)<9)!'(X?9N."P") X
;;^DD(6919.2,11,1,0)=^.1^^0
;;^DD(6919.2,11,2)=S Y(0)=Y X ^DD(6919.2,11,2,9.2) S Y(7)=X S X=6,Y(8)=X S X=9,X=$E(Y(7),Y(8),X) S Y=X,X=Y(6),X=X_Y S Y=X
;;^DD(6919.2,11,2,9.2)=S X=Y(0),Y(1)=X S X=1,Y(2)=X S X=3,X=$E(Y(1),Y(2),X)_"-",Y(3)=X S X=Y(0),Y(4)=X S X=4,Y(5)=X S X=5,X=$E(Y(4),Y(5),X) S Y=X,X=Y(3),X=X_Y_"-",Y(6)=X S X=Y(0)
;;^DD(6919.2,11,2.1)=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
;;^DD(6919.2,11,3)=ANSWER MUST BE 9DIGITS IN LENGTH, AFFIX 'P' FOR PSEUDO IF UNSURE
;;^DD(6919.2,11,"DT")=2860915
;;^DD(6919.2,12,0)=SEX^S^M:MALE;F:FEMALE;^1;4^Q
;;^DD(6919.2,13,0)=PERSONNEL STATUS^S^A:EMPLOYEE;B:VOLUNTEER;C:CONTRACTOR;D:INPATIENT;E:OUTPATIENT;F:STUDENT;G:VISITOR;Z:PERSON N.E.C.;^1;5^Q
;;^DD(6919.2,13,3)=SELECT CODE, N.E.C. MEANS NOT ELSEWHERE CLASSIFIED
;;^DD(6919.2,14,0)=AGE^NJ2,0^^1;6^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1N.N) X
;;^DD(6919.2,14,3)=TYPE A WHOLE NUMBER BETWEEN 1 AND 99
;;^DD(6919.2,15,0)=PAY PLAN^F^^1;7^K:$L(X)>2!($L(X)<2)!'(X?2A) X
;;^DD(6919.2,15,3)=ANSWER MUST BE 2 CHARACTERS IN LENGTH, (e.g. GS, WG, WS, etc.)
;;^DD(6919.2,16,0)=OCCUPATIONAL CODE^F^^1;8^K:$L(X)>5!($L(X)<5)!'(X?5N) X
;;^DD(6919.2,16,3)=ANSWER MUST BE 5 DIGITS IN LENGTH, (e.g. 00858)
;;^DD(6919.2,17,0)=GRADE^F^^1;9^K:$L(X)>2!($L(X)<2)!'(X?2N) X
;;^DD(6919.2,17,3)=ANSWER MUST BE 2 DIGITS IN LENGTH, (e.g. 07)
;;^DD(6919.2,18,0)=HOME ADDRESS^6919.21^^2;0
;;^DD(6919.2,19,0)=HOME PHONE #^F^^3;1^K:$L(X)>12!($L(X)<7)!'(X'?.C) X
;;^DD(6919.2,19,3)=ANSWER MUST BE 7-12 CHARACTERS IN LENGTH (e.g. 215-555-1212)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENARY201 3984 printed Dec 13, 2024@01:51:46 Page 2
ENARX201 ;(WASH ISC)/SAW/DH-2162 Archive ;2.23.98
+1 ;;7.0;ENGINEERING;**48**;Aug 17, 1993
+2 FOR I=1:1
SET X=$TEXT(Q+I)
if X=""
QUIT
SET Y=$PIECE(X,"=",2,99)
SET X=$PIECE($EXTRACT(X,4,99),"=",1)
if X=""
SET X=$PIECE(Y,"=",1)
SET Y=%_$PIECE(Y,"=",2,99)
XECUTE NO
IF '$TEST
SET @X=Y
Q QUIT
+1 ;;^DIC(6919.2,0,"DD")=@
+2 ;;^DIC(6919.2,0,"GL")=^ENAR(6919.2,
+3 ;;^DIC(6919.2,0,"WR")=@
+4 ;;^DIC("B","2162 ACCIDENT ARCHIVE",6919.2)=
+5 ;;^DD(6919.2,0)=FIELD^^57.5^62
+6 ;;^DD(6919.2,0,"IX","B",6919.2,.01)=
+7 ;;^DD(6919.2,0,"NM","2162 ACCIDENT ARCHIVE")=
+8 ;;^DD(6919.2,.01,0)=LOCAL ENGINEERING #^RF^^0;1^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>12!($L(X)<6)!(X'?.ANP) X
+9 ;;^DD(6919.2,.01,1,0)=^.1
+10 ;;^DD(6919.2,.01,1,1,0)=6919.2^B
+11 ;;^DD(6919.2,.01,1,1,1)=S ^ENAR(6919.2,"B",$E(X,1,30),DA)=""
+12 ;;^DD(6919.2,.01,1,1,2)=K ^ENAR(6919.2,"B",$E(X,1,30),DA)
+13 ;;^DD(6919.2,.01,3)=8 digits (YYYYNNNN), where YYYY => Fiscal Year.
+14 ;;^DD(6919.2,1,0)=CASE NUMBER^F^^0;2^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>4!($L(X)<4)!'(X?4N) X
+15 ;;^DD(6919.2,1,1,0)=^.1^^0
+16 ;;^DD(6919.2,1,3)=ANSWER MUST BE 4 DIGITS IN LENGTH
+17 ;;^DD(6919.2,1,"DT")=2860915
+18 ;;^DD(6919.2,2,0)=REPORT TYPE^S^I:INITIAL;S:SUPPLEMENTAL;C:CORRECTED;^0;3^Q
+19 ;;^DD(6919.2,3,0)=RESULT^S^P:PROPERTY ONLY;I:INJURY or ILLNESS;B:BOTH;^0;4^Q
+20 ;;^DD(6919.2,4,0)=ACCIDENT CLASS^S^A:MOTOR VEHICLE;B:LABORATORY;C:OFFICE;G:ASSEMBLY;J:PATIENT CARE;L:STORAGE;M:GROUNDS;N:DIETETICS;Z:OTHER;^0;5^Q
+21 ;;^DD(6919.2,5,0)=OCCURRENCE DATE^D^^0;6^S %DT="EX" D ^%DT S X=Y K:3000000<X!(2800000>X) X
+22 ;;^DD(6919.2,5,3)=TYPE A DATE BETWEEN 1980 AND 2000
+23 ;;^DD(6919.2,6,0)=OCCURRENCE TIME^F^^0;7^K:$L(X)>4!($L(X)<4)!'(X?4N) X
+24 ;;^DD(6919.2,6,3)=ENTER MILITARY TIME (0000-2400 HRS.)
+25 ;;^DD(6919.2,7,0)=SITE^S^A:ON REPORTING ACTIVITY PROPERTY;B:OFF REPORTING ACTIVITY PROPERTY;^0;8^Q
+26 ;;^DD(6919.2,7.5,0)=SPECIFIC LOCATION^F^^0;9^K:$L(X)>25!($L(X)<4) X
+27 ;;^DD(6919.2,7.5,3)=ANSWER MUST BE 4-25 CHARACTERS IN LENGTH
+28 ;;^DD(6919.2,8,0)=TORT CLAIM^S^Y:YES, IS POSSIBLE;N:NO, NOT POSSIBLE;^0;10^Q
+29 ;;^DD(6919.2,9,0)=LAST NAME OF INVOLVED^F^^1;1^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>16!($L(X)<3)!'(X'?.C) X
+30 ;;^DD(6919.2,9,1,0)=^.1^^0
+31 ;;^DD(6919.2,9,3)=ANSWER MUST BE LAST NAME, 3-16 CHARACTERS IN LENGTH
+32 ;;^DD(6919.2,9,"DT")=2860915
+33 ;;^DD(6919.2,10,0)=FIRST/MIDDLE INITIALS^F^^1;2^K:$L(X)>2!($L(X)<1)!'(X?.A) X
+34 ;;^DD(6919.2,10,3)=ANSWER MUST BE 1-2 CHARACTERS IN LENGTH
+35 ;;^DD(6919.2,11,0)=SSN^FO^^1;3^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>10!($L(X)<9)!'(X?9N."P") X
+36 ;;^DD(6919.2,11,1,0)=^.1^^0
+37 ;;^DD(6919.2,11,2)=S Y(0)=Y X ^DD(6919.2,11,2,9.2) S Y(7)=X S X=6,Y(8)=X S X=9,X=$E(Y(7),Y(8),X) S Y=X,X=Y(6),X=X_Y S Y=X
+38 ;;^DD(6919.2,11,2,9.2)=S X=Y(0),Y(1)=X S X=1,Y(2)=X S X=3,X=$E(Y(1),Y(2),X)_"-",Y(3)=X S X=Y(0),Y(4)=X S X=4,Y(5)=X S X=5,X=$E(Y(4),Y(5),X) S Y=X,X=Y(3),X=X_Y_"-",Y(6)=X S X=Y(0)
+39 ;;^DD(6919.2,11,2.1)=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
+40 ;;^DD(6919.2,11,3)=ANSWER MUST BE 9DIGITS IN LENGTH, AFFIX 'P' FOR PSEUDO IF UNSURE
+41 ;;^DD(6919.2,11,"DT")=2860915
+42 ;;^DD(6919.2,12,0)=SEX^S^M:MALE;F:FEMALE;^1;4^Q
+43 ;;^DD(6919.2,13,0)=PERSONNEL STATUS^S^A:EMPLOYEE;B:VOLUNTEER;C:CONTRACTOR;D:INPATIENT;E:OUTPATIENT;F:STUDENT;G:VISITOR;Z:PERSON N.E.C.;^1;5^Q
+44 ;;^DD(6919.2,13,3)=SELECT CODE, N.E.C. MEANS NOT ELSEWHERE CLASSIFIED
+45 ;;^DD(6919.2,14,0)=AGE^NJ2,0^^1;6^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1N.N) X
+46 ;;^DD(6919.2,14,3)=TYPE A WHOLE NUMBER BETWEEN 1 AND 99
+47 ;;^DD(6919.2,15,0)=PAY PLAN^F^^1;7^K:$L(X)>2!($L(X)<2)!'(X?2A) X
+48 ;;^DD(6919.2,15,3)=ANSWER MUST BE 2 CHARACTERS IN LENGTH, (e.g. GS, WG, WS, etc.)
+49 ;;^DD(6919.2,16,0)=OCCUPATIONAL CODE^F^^1;8^K:$L(X)>5!($L(X)<5)!'(X?5N) X
+50 ;;^DD(6919.2,16,3)=ANSWER MUST BE 5 DIGITS IN LENGTH, (e.g. 00858)
+51 ;;^DD(6919.2,17,0)=GRADE^F^^1;9^K:$L(X)>2!($L(X)<2)!'(X?2N) X
+52 ;;^DD(6919.2,17,3)=ANSWER MUST BE 2 DIGITS IN LENGTH, (e.g. 07)
+53 ;;^DD(6919.2,18,0)=HOME ADDRESS^6919.21^^2;0
+54 ;;^DD(6919.2,19,0)=HOME PHONE #^F^^3;1^K:$L(X)>12!($L(X)<7)!'(X'?.C) X
+55 ;;^DD(6919.2,19,3)=ANSWER MUST BE 7-12 CHARACTERS IN LENGTH (e.g. 215-555-1212)
