ACKQAG08 ;DDC/PJU;UPDATE AUDIOMETRIC EXAM FILE; [10/06/2005 ]
;;3.0;QUASAR AUDIOMETRIC MODULE;**12**;11/01/02;
;Loop through entries in 509850.9 and convert 'No Response' tags to
;'+' added to value in initial or final fields. Retest field
;was added with patch 12, so no tags that need conversion.
N IEN,P,N,CTR S (CTR,IEN)=0 ;W !!,"START:",$$HTE^XLFDT($H)
L1 S IEN=$O(^ACK(509850.9,IEN)) G:'IEN PART2 ;S CTR=CTR+1
I $D(^ACK(509850.9,IEN,11)) D ;initial R air
.F P=1:1:12 D
..S N=$P(^ACK(509850.9,IEN,11),U,P) Q:'N
..I (N=2)!(N=3) D ;no response or masked no response
...I $P($G(^ACK(509850.9,IEN,10)),U,P)["+" D Q
....S $P(^ACK(509850.9,IEN,11),U,P)=$S(N=2:"",N=3:1)
...S $P(^ACK(509850.9,IEN,10),U,P)=$P($G(^ACK(509850.9,IEN,10)),U,P)_"+"
...S $P(^ACK(509850.9,IEN,11),U,P)=$S(N=2:"",N=3:1)
I $D(^ACK(509850.9,IEN,21)) D
.F P=1:1:12 D ;final R air
..S N=$P(^ACK(509850.9,IEN,21),U,P) Q:'N
..I (N=2)!(N=3) D
...I $P($G(^ACK(509850.9,IEN,20)),U,P)["+" D Q
....S $P(^ACK(509850.9,IEN,21),U,P)=$S(N=2:"",N=3:1)
...S $P(^ACK(509850.9,IEN,20),U,P)=$P($G(^ACK(509850.9,IEN,20)),U,P)_"+"
...S $P(^ACK(509850.9,IEN,21),U,P)=$S(N=2:"",N=3:1)
I $D(^ACK(509850.9,IEN,31)) D
.F P=1:1:12 D ;Initial L air
..S N=$P(^ACK(509850.9,IEN,31),U,P) Q:'N
..I (N=2)!(N=3) D
...I $P($G(^ACK(509850.9,IEN,30)),U,P)["+" D Q
....S $P(^ACK(509850.9,IEN,31),U,P)=$S(N=2:"",N=3:1)
...S $P(^ACK(509850.9,IEN,30),U,P)=$P($G(^ACK(509850.9,IEN,30)),U,P)_"+"
...S $P(^ACK(509850.9,IEN,31),U,P)=$S(N=2:"",N=3:1)
I $D(^ACK(509850.9,IEN,41)) D
.F P=1:1:12 D ;final L air
..S N=$P($G(^ACK(509850.9,IEN,41)),U,P) Q:'N
..I (N=2)!(N=3) D
...I $P($G(^ACK(509850.9,IEN,40)),U,P)["+" D Q
....S $P(^ACK(509850.9,IEN,41),U,P)=$S(N=2:"",N=3:1)
...S $P(^ACK(509850.9,IEN,40),U,P)=$P($G(^ACK(509850.9,IEN,40)),U,P)_"+"
...S $P(^ACK(509850.9,IEN,41),U,P)=$S(N=2:"",N=3:1)
I $D(^ACK(509850.9,IEN,71)) D
.F P=1:1:9 D ;Initial R bone
..S N=$P(^ACK(509850.9,IEN,71),U,P) Q:'N
..I (N=2)!(N=3) D
...I $P($G(^ACK(509850.9,IEN,70)),U,P)["+" D Q
....S $P(^ACK(509850.9,IEN,71),U,P)=$S(N=2:"",N=3:1)
...S $P(^ACK(509850.9,IEN,70),U,P)=$P($G(^ACK(509850.9,IEN,70)),U,P)_"+"
...S $P(^ACK(509850.9,IEN,71),U,P)=$S(N=2:"",N=3:1)
I $D(^ACK(509850.9,IEN,76)) D
.F P=1:1:9 D ;Final R bone
..S N=$P(^ACK(509850.9,IEN,76),U,P) Q:'N
..I (N=2)!(N=3) D
...I $P($G(^ACK(509850.9,IEN,75)),U,P)["+" D Q
....S $P(^ACK(509850.9,IEN,76),U,P)=$S(N=2:"",N=3:1)
...S $P(^ACK(509850.9,IEN,75),U,P)=$P($G(^ACK(509850.9,IEN,75)),U,P)_"+"
...S $P(^ACK(509850.9,IEN,76),U,P)=$S(N=2:"",N=3:1)
I $D(^ACK(509850.9,IEN,81)) D
.F P=1:1:9 D ;Initial L bone
..S N=$P(^ACK(509850.9,IEN,81),U,P) Q:'N
..I (N=2)!(N=3) D
...I $P($G(^ACK(509850.9,IEN,80)),U,P)["+" D Q
....S $P(^ACK(509850.9,IEN,81),U,P)=$S(N=2:"",N=3:1)
...S $P(^ACK(509850.9,IEN,80),U,P)=$P($G(^ACK(509850.9,IEN,80)),U,P)_"+"
...S $P(^ACK(509850.9,IEN,81),U,P)=$S(N=2:"",N=3:1)
I $D(^ACK(509850.9,IEN,86)) D
.F P=1:1:9 D ;Final l bone
..S N=$P(^ACK(509850.9,IEN,86),U,P) Q:'N
..I (N=2)!(N=3) D
...I $P($G(^ACK(509850.9,IEN,85)),U,P)["+" D Q
....S $P(^ACK(509850.9,IEN,86),U,P)=$S(N=2:"",N=3:1)
...S $P(^ACK(509850.9,IEN,85),U,P)=$P($G(^ACK(509850.9,IEN,85)),U,P)_"+"
...S $P(^ACK(509850.9,IEN,86),U,P)=$S(N=2:"",N=3:1)
G L1
PART2 ;evaluate and move initial readings(masked) to final when needed
;W !!,"START PART2 :",$$HTE^XLFDT($H)
N V1,T1,L1,V2,T2,L2 ;initial and final value, tag & mask level nodes
N NV1,NL1,NT1,NV2,NL2,NT2 ;NODES FOR CHANGES IF NEEDED
S IEN=0
L2 S IEN=$O(^ACK(509850.9,IEN)) G:'IEN END
G:'$D(^ACK(509850.9,IEN,0)) L2 ;INVALID ENTRY
AIRR ;Right Air
S NV1="^ACK(509850.9,"_IEN_",10)"
S NT1="^ACK(509850.9,"_IEN_",11)"
S NL1="^ACK(509850.9,"_IEN_",50)"
S NV2="^ACK(509850.9,"_IEN_",20)"
S NT2="^ACK(509850.9,"_IEN_",21)"
S NL2="^ACK(509850.9,"_IEN_",51)"
F P=1:1:12 D ;
.S V1=$P($G(^ACK(509850.9,IEN,10)),U,P)
.S T1=$P($G(^ACK(509850.9,IEN,11)),U,P)
.S L1=$P($G(^ACK(509850.9,IEN,50)),U,P)
.S V2=$P($G(^ACK(509850.9,IEN,20)),U,P)
.S T2=$P($G(^ACK(509850.9,IEN,21)),U,P)
.S L2=$P($G(^ACK(509850.9,IEN,51)),U,P)
.I (T1'="")!(T2'="")!(L1'="") D RULES()
AIRL ;Left Air
S NV1="^ACK(509850.9,"_IEN_",30)"
S NT1="^ACK(509850.9,"_IEN_",31)"
S NL1="^ACK(509850.9,"_IEN_",60)"
S NV2="^ACK(509850.9,"_IEN_",40)"
S NT2="^ACK(509850.9,"_IEN_",41)"
S NL2="^ACK(509850.9,"_IEN_",61)"
F P=1:1:12 D ;
.S V1=$P($G(^ACK(509850.9,IEN,30)),U,P)
.S T1=$P($G(^ACK(509850.9,IEN,31)),U,P)
.S L1=$P($G(^ACK(509850.9,IEN,60)),U,P)
.S V2=$P($G(^ACK(509850.9,IEN,40)),U,P)
.S T2=$P($G(^ACK(509850.9,IEN,41)),U,P)
.S L2=$P($G(^ACK(509850.9,IEN,61)),U,P)
.I (T1'="")!(T2'="")!(L1'="") D RULES() ;apply rules
RBONE ;Right Bone
S NV1="^ACK(509850.9,"_IEN_",70)"
S NT1="^ACK(509850.9,"_IEN_",71)"
S NL1="^ACK(509850.9,"_IEN_",90)"
S NV2="^ACK(509850.9,"_IEN_",75)"
S NT2="^ACK(509850.9,"_IEN_",76)"
S NL2="^ACK(509850.9,"_IEN_",91)"
F P=1:1:9 D
.S V1=$P($G(^ACK(509850.9,IEN,70)),U,P)
.S T1=$P($G(^ACK(509850.9,IEN,71)),U,P)
.S L1=$P($G(^ACK(509850.9,IEN,90)),U,P)
.S V2=$P($G(^ACK(509850.9,IEN,75)),U,P)
.S T2=$P($G(^ACK(509850.9,IEN,76)),U,P)
.S L2=$P($G(^ACK(509850.9,IEN,91)),U,P)
.I (T1'="")!(T2'="")!(L1'="") D RULES() ;apply rules
LBONE ;Left Bone
S NV1="^ACK(509850.9,"_IEN_",80)"
S NT1="^ACK(509850.9,"_IEN_",81)"
S NL1="^ACK(509850.9,"_IEN_",100)"
S NV2="^ACK(509850.9,"_IEN_",85)"
S NT2="^ACK(509850.9,"_IEN_",86)"
S NL2="^ACK(509850.9,"_IEN_",101)"
F P=1:1:9 D
.S V1=$P($G(^ACK(509850.9,IEN,80)),U,P)
.S T1=$P($G(^ACK(509850.9,IEN,81)),U,P)
.S L1=$P($G(^ACK(509850.9,IEN,100)),U,P)
.S V2=$P($G(^ACK(509850.9,IEN,85)),U,P)
.S T2=$P($G(^ACK(509850.9,IEN,86)),U,P)
.S L2=$P($G(^ACK(509850.9,IEN,101)),U,P)
.I (T1'="")!(T2'="")!(L1'="") D RULES() ;apply rules
G L2
END ;W !!,"STOP:",$$HTE^XLFDT($H),?60,"RECORDS:",CTR
S DIK="^ACK(509850.9,",DIK(1)=".02^DFN2" D ENALL^DIK K DIK
Q
;
RULES() ;Adjust Masking level, tag and value for *3*12 if needed
;no CNT,DNT,CNM etc in 3*3 records but may have "+" from part1
;L2 could be CNM if a re-run,V1 could be CNT or DNT if a re-run
;1.final has val and (ML or mask tag) then will only use final on graph and just val for init
N MS1,MS2 S (MS1,MS2)=""
I L2!T2 S MS2=1 ;final masked
I L1'=""!T1 S MS1=1 ;initial masked
I V2'="",MS2 D Q ;has final masked value
.S $P(@(NT1),U,P)="" ;elim init tag
.S $P(@(NT2),U,P)="" ;elim final tag
.S $P(@(NL1),U,P)="" ;elim init ML
.I T2,L2="",V2'["*" S $P(@(NV2),U,P)=V2_"*" ;adjust if just had tag
;2.fin missing Val or just + or ML and init has both then replace fin
I (('MS2)!("+"[V2)),("+"'[V1),MS1 D Q
.I T1,L1="",V1'["*" S V1=V1_"*" ;adjust if just had tag
.S $P(@(NV2),U,P)=V1 ;replace final val with initial val
.S $P(@(NL2),U,P)=L1 ;replace final ML with initial ML
.S $P(@(NT2),U,P)="" ;elim final tag
.S $P(@(NV1),U,P)="" ;elim init val
.S $P(@(NL1),U,P)="" ;elim init ML
.S $P(@(NT1),U,P)="" ;elim init tag
E I (T1'="")!(T2'="")!(L1'="") D ;eliminate 0's & invalid field values
.S $P(@(NT1),U,P)="" ;elim init tag
.S $P(@(NT2),U,P)="" ;elim final tag
.S $P(@(NL1),U,P)="" ;elim init ML
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQAG08 7298 printed Apr 09, 2024@21:34:33 Page 2
ACKQAG08 ;DDC/PJU;UPDATE AUDIOMETRIC EXAM FILE; [10/06/2005 ]
+1 ;;3.0;QUASAR AUDIOMETRIC MODULE;**12**;11/01/02;
+2 ;Loop through entries in 509850.9 and convert 'No Response' tags to
+3 ;'+' added to value in initial or final fields. Retest field
+4 ;was added with patch 12, so no tags that need conversion.
+5 ;W !!,"START:",$$HTE^XLFDT($H)
NEW IEN,P,N,CTR
SET (CTR,IEN)=0
L1 ;S CTR=CTR+1
SET IEN=$ORDER(^ACK(509850.9,IEN))
if 'IEN
GOTO PART2
+1 ;initial R air
IF $DATA(^ACK(509850.9,IEN,11))
Begin DoDot:1
+2 FOR P=1:1:12
Begin DoDot:2
+3 SET N=$PIECE(^ACK(509850.9,IEN,11),U,P)
if 'N
QUIT
+4 ;no response or masked no response
IF (N=2)!(N=3)
Begin DoDot:3
+5 IF $PIECE($GET(^ACK(509850.9,IEN,10)),U,P)["+"
Begin DoDot:4
+6 SET $PIECE(^ACK(509850.9,IEN,11),U,P)=$SELECT(N=2:"",N=3:1)
End DoDot:4
QUIT
+7 SET $PIECE(^ACK(509850.9,IEN,10),U,P)=$PIECE($GET(^ACK(509850.9,IEN,10)),U,P)_"+"
+8 SET $PIECE(^ACK(509850.9,IEN,11),U,P)=$SELECT(N=2:"",N=3:1)
End DoDot:3
End DoDot:2
End DoDot:1
+9 IF $DATA(^ACK(509850.9,IEN,21))
Begin DoDot:1
+10 ;final R air
FOR P=1:1:12
Begin DoDot:2
+11 SET N=$PIECE(^ACK(509850.9,IEN,21),U,P)
if 'N
QUIT
+12 IF (N=2)!(N=3)
Begin DoDot:3
+13 IF $PIECE($GET(^ACK(509850.9,IEN,20)),U,P)["+"
Begin DoDot:4
+14 SET $PIECE(^ACK(509850.9,IEN,21),U,P)=$SELECT(N=2:"",N=3:1)
End DoDot:4
QUIT
+15 SET $PIECE(^ACK(509850.9,IEN,20),U,P)=$PIECE($GET(^ACK(509850.9,IEN,20)),U,P)_"+"
+16 SET $PIECE(^ACK(509850.9,IEN,21),U,P)=$SELECT(N=2:"",N=3:1)
End DoDot:3
End DoDot:2
End DoDot:1
+17 IF $DATA(^ACK(509850.9,IEN,31))
Begin DoDot:1
+18 ;Initial L air
FOR P=1:1:12
Begin DoDot:2
+19 SET N=$PIECE(^ACK(509850.9,IEN,31),U,P)
if 'N
QUIT
+20 IF (N=2)!(N=3)
Begin DoDot:3
+21 IF $PIECE($GET(^ACK(509850.9,IEN,30)),U,P)["+"
Begin DoDot:4
+22 SET $PIECE(^ACK(509850.9,IEN,31),U,P)=$SELECT(N=2:"",N=3:1)
End DoDot:4
QUIT
+23 SET $PIECE(^ACK(509850.9,IEN,30),U,P)=$PIECE($GET(^ACK(509850.9,IEN,30)),U,P)_"+"
+24 SET $PIECE(^ACK(509850.9,IEN,31),U,P)=$SELECT(N=2:"",N=3:1)
End DoDot:3
End DoDot:2
End DoDot:1
+25 IF $DATA(^ACK(509850.9,IEN,41))
Begin DoDot:1
+26 ;final L air
FOR P=1:1:12
Begin DoDot:2
+27 SET N=$PIECE($GET(^ACK(509850.9,IEN,41)),U,P)
if 'N
QUIT
+28 IF (N=2)!(N=3)
Begin DoDot:3
+29 IF $PIECE($GET(^ACK(509850.9,IEN,40)),U,P)["+"
Begin DoDot:4
+30 SET $PIECE(^ACK(509850.9,IEN,41),U,P)=$SELECT(N=2:"",N=3:1)
End DoDot:4
QUIT
+31 SET $PIECE(^ACK(509850.9,IEN,40),U,P)=$PIECE($GET(^ACK(509850.9,IEN,40)),U,P)_"+"
+32 SET $PIECE(^ACK(509850.9,IEN,41),U,P)=$SELECT(N=2:"",N=3:1)
End DoDot:3
End DoDot:2
End DoDot:1
+33 IF $DATA(^ACK(509850.9,IEN,71))
Begin DoDot:1
+34 ;Initial R bone
FOR P=1:1:9
Begin DoDot:2
+35 SET N=$PIECE(^ACK(509850.9,IEN,71),U,P)
if 'N
QUIT
+36 IF (N=2)!(N=3)
Begin DoDot:3
+37 IF $PIECE($GET(^ACK(509850.9,IEN,70)),U,P)["+"
Begin DoDot:4
+38 SET $PIECE(^ACK(509850.9,IEN,71),U,P)=$SELECT(N=2:"",N=3:1)
End DoDot:4
QUIT
+39 SET $PIECE(^ACK(509850.9,IEN,70),U,P)=$PIECE($GET(^ACK(509850.9,IEN,70)),U,P)_"+"
+40 SET $PIECE(^ACK(509850.9,IEN,71),U,P)=$SELECT(N=2:"",N=3:1)
End DoDot:3
End DoDot:2
End DoDot:1
+41 IF $DATA(^ACK(509850.9,IEN,76))
Begin DoDot:1
+42 ;Final R bone
FOR P=1:1:9
Begin DoDot:2
+43 SET N=$PIECE(^ACK(509850.9,IEN,76),U,P)
if 'N
QUIT
+44 IF (N=2)!(N=3)
Begin DoDot:3
+45 IF $PIECE($GET(^ACK(509850.9,IEN,75)),U,P)["+"
Begin DoDot:4
+46 SET $PIECE(^ACK(509850.9,IEN,76),U,P)=$SELECT(N=2:"",N=3:1)
End DoDot:4
QUIT
+47 SET $PIECE(^ACK(509850.9,IEN,75),U,P)=$PIECE($GET(^ACK(509850.9,IEN,75)),U,P)_"+"
+48 SET $PIECE(^ACK(509850.9,IEN,76),U,P)=$SELECT(N=2:"",N=3:1)
End DoDot:3
End DoDot:2
End DoDot:1
+49 IF $DATA(^ACK(509850.9,IEN,81))
Begin DoDot:1
+50 ;Initial L bone
FOR P=1:1:9
Begin DoDot:2
+51 SET N=$PIECE(^ACK(509850.9,IEN,81),U,P)
if 'N
QUIT
+52 IF (N=2)!(N=3)
Begin DoDot:3
+53 IF $PIECE($GET(^ACK(509850.9,IEN,80)),U,P)["+"
Begin DoDot:4
+54 SET $PIECE(^ACK(509850.9,IEN,81),U,P)=$SELECT(N=2:"",N=3:1)
End DoDot:4
QUIT
+55 SET $PIECE(^ACK(509850.9,IEN,80),U,P)=$PIECE($GET(^ACK(509850.9,IEN,80)),U,P)_"+"
+56 SET $PIECE(^ACK(509850.9,IEN,81),U,P)=$SELECT(N=2:"",N=3:1)
End DoDot:3
End DoDot:2
End DoDot:1
+57 IF $DATA(^ACK(509850.9,IEN,86))
Begin DoDot:1
+58 ;Final l bone
FOR P=1:1:9
Begin DoDot:2
+59 SET N=$PIECE(^ACK(509850.9,IEN,86),U,P)
if 'N
QUIT
+60 IF (N=2)!(N=3)
Begin DoDot:3
+61 IF $PIECE($GET(^ACK(509850.9,IEN,85)),U,P)["+"
Begin DoDot:4
+62 SET $PIECE(^ACK(509850.9,IEN,86),U,P)=$SELECT(N=2:"",N=3:1)
End DoDot:4
QUIT
+63 SET $PIECE(^ACK(509850.9,IEN,85),U,P)=$PIECE($GET(^ACK(509850.9,IEN,85)),U,P)_"+"
+64 SET $PIECE(^ACK(509850.9,IEN,86),U,P)=$SELECT(N=2:"",N=3:1)
End DoDot:3
End DoDot:2
End DoDot:1
+65 GOTO L1
PART2 ;evaluate and move initial readings(masked) to final when needed
+1 ;W !!,"START PART2 :",$$HTE^XLFDT($H)
+2 ;initial and final value, tag & mask level nodes
NEW V1,T1,L1,V2,T2,L2
+3 ;NODES FOR CHANGES IF NEEDED
NEW NV1,NL1,NT1,NV2,NL2,NT2
+4 SET IEN=0
L2 SET IEN=$ORDER(^ACK(509850.9,IEN))
if 'IEN
GOTO END
+1 ;INVALID ENTRY
if '$DATA(^ACK(509850.9,IEN,0))
GOTO L2
AIRR ;Right Air
+1 SET NV1="^ACK(509850.9,"_IEN_",10)"
+2 SET NT1="^ACK(509850.9,"_IEN_",11)"
+3 SET NL1="^ACK(509850.9,"_IEN_",50)"
+4 SET NV2="^ACK(509850.9,"_IEN_",20)"
+5 SET NT2="^ACK(509850.9,"_IEN_",21)"
+6 SET NL2="^ACK(509850.9,"_IEN_",51)"
+7 ;
FOR P=1:1:12
Begin DoDot:1
+8 SET V1=$PIECE($GET(^ACK(509850.9,IEN,10)),U,P)
+9 SET T1=$PIECE($GET(^ACK(509850.9,IEN,11)),U,P)
+10 SET L1=$PIECE($GET(^ACK(509850.9,IEN,50)),U,P)
+11 SET V2=$PIECE($GET(^ACK(509850.9,IEN,20)),U,P)
+12 SET T2=$PIECE($GET(^ACK(509850.9,IEN,21)),U,P)
+13 SET L2=$PIECE($GET(^ACK(509850.9,IEN,51)),U,P)
+14 IF (T1'="")!(T2'="")!(L1'="")
DO RULES()
End DoDot:1
AIRL ;Left Air
+1 SET NV1="^ACK(509850.9,"_IEN_",30)"
+2 SET NT1="^ACK(509850.9,"_IEN_",31)"
+3 SET NL1="^ACK(509850.9,"_IEN_",60)"
+4 SET NV2="^ACK(509850.9,"_IEN_",40)"
+5 SET NT2="^ACK(509850.9,"_IEN_",41)"
+6 SET NL2="^ACK(509850.9,"_IEN_",61)"
+7 ;
FOR P=1:1:12
Begin DoDot:1
+8 SET V1=$PIECE($GET(^ACK(509850.9,IEN,30)),U,P)
+9 SET T1=$PIECE($GET(^ACK(509850.9,IEN,31)),U,P)
+10 SET L1=$PIECE($GET(^ACK(509850.9,IEN,60)),U,P)
+11 SET V2=$PIECE($GET(^ACK(509850.9,IEN,40)),U,P)
+12 SET T2=$PIECE($GET(^ACK(509850.9,IEN,41)),U,P)
+13 SET L2=$PIECE($GET(^ACK(509850.9,IEN,61)),U,P)
+14 ;apply rules
IF (T1'="")!(T2'="")!(L1'="")
DO RULES()
End DoDot:1
RBONE ;Right Bone
+1 SET NV1="^ACK(509850.9,"_IEN_",70)"
+2 SET NT1="^ACK(509850.9,"_IEN_",71)"
+3 SET NL1="^ACK(509850.9,"_IEN_",90)"
+4 SET NV2="^ACK(509850.9,"_IEN_",75)"
+5 SET NT2="^ACK(509850.9,"_IEN_",76)"
+6 SET NL2="^ACK(509850.9,"_IEN_",91)"
+7 FOR P=1:1:9
Begin DoDot:1
+8 SET V1=$PIECE($GET(^ACK(509850.9,IEN,70)),U,P)
+9 SET T1=$PIECE($GET(^ACK(509850.9,IEN,71)),U,P)
+10 SET L1=$PIECE($GET(^ACK(509850.9,IEN,90)),U,P)
+11 SET V2=$PIECE($GET(^ACK(509850.9,IEN,75)),U,P)
+12 SET T2=$PIECE($GET(^ACK(509850.9,IEN,76)),U,P)
+13 SET L2=$PIECE($GET(^ACK(509850.9,IEN,91)),U,P)
+14 ;apply rules
IF (T1'="")!(T2'="")!(L1'="")
DO RULES()
End DoDot:1
LBONE ;Left Bone
+1 SET NV1="^ACK(509850.9,"_IEN_",80)"
+2 SET NT1="^ACK(509850.9,"_IEN_",81)"
+3 SET NL1="^ACK(509850.9,"_IEN_",100)"
+4 SET NV2="^ACK(509850.9,"_IEN_",85)"
+5 SET NT2="^ACK(509850.9,"_IEN_",86)"
+6 SET NL2="^ACK(509850.9,"_IEN_",101)"
+7 FOR P=1:1:9
Begin DoDot:1
+8 SET V1=$PIECE($GET(^ACK(509850.9,IEN,80)),U,P)
+9 SET T1=$PIECE($GET(^ACK(509850.9,IEN,81)),U,P)
+10 SET L1=$PIECE($GET(^ACK(509850.9,IEN,100)),U,P)
+11 SET V2=$PIECE($GET(^ACK(509850.9,IEN,85)),U,P)
+12 SET T2=$PIECE($GET(^ACK(509850.9,IEN,86)),U,P)
+13 SET L2=$PIECE($GET(^ACK(509850.9,IEN,101)),U,P)
+14 ;apply rules
IF (T1'="")!(T2'="")!(L1'="")
DO RULES()
End DoDot:1
+15 GOTO L2
END ;W !!,"STOP:",$$HTE^XLFDT($H),?60,"RECORDS:",CTR
+1 SET DIK="^ACK(509850.9,"
SET DIK(1)=".02^DFN2"
DO ENALL^DIK
KILL DIK
+2 QUIT
+3 ;
RULES() ;Adjust Masking level, tag and value for *3*12 if needed
+1 ;no CNT,DNT,CNM etc in 3*3 records but may have "+" from part1
+2 ;L2 could be CNM if a re-run,V1 could be CNT or DNT if a re-run
+3 ;1.final has val and (ML or mask tag) then will only use final on graph and just val for init
+4 NEW MS1,MS2
SET (MS1,MS2)=""
+5 ;final masked
IF L2!T2
SET MS2=1
+6 ;initial masked
IF L1'=""!T1
SET MS1=1
+7 ;has final masked value
IF V2'=""
IF MS2
Begin DoDot:1
+8 ;elim init tag
SET $PIECE(@(NT1),U,P)=""
+9 ;elim final tag
SET $PIECE(@(NT2),U,P)=""
+10 ;elim init ML
SET $PIECE(@(NL1),U,P)=""
+11 ;adjust if just had tag
IF T2
IF L2=""
IF V2'["*"
SET $PIECE(@(NV2),U,P)=V2_"*"
End DoDot:1
QUIT
+12 ;2.fin missing Val or just + or ML and init has both then replace fin
+13 IF (('MS2)!("+"[V2))
IF ("+"'[V1)
IF MS1
Begin DoDot:1
+14 ;adjust if just had tag
IF T1
IF L1=""
IF V1'["*"
SET V1=V1_"*"
+15 ;replace final val with initial val
SET $PIECE(@(NV2),U,P)=V1
+16 ;replace final ML with initial ML
SET $PIECE(@(NL2),U,P)=L1
+17 ;elim final tag
SET $PIECE(@(NT2),U,P)=""
+18 ;elim init val
SET $PIECE(@(NV1),U,P)=""
+19 ;elim init ML
SET $PIECE(@(NL1),U,P)=""
+20 ;elim init tag
SET $PIECE(@(NT1),U,P)=""
End DoDot:1
QUIT
+21 ;eliminate 0's & invalid field values
IF '$TEST
IF (T1'="")!(T2'="")!(L1'="")
Begin DoDot:1
+22 ;elim init tag
SET $PIECE(@(NT1),U,P)=""
+23 ;elim final tag
SET $PIECE(@(NT2),U,P)=""
+24 ;elim init ML
SET $PIECE(@(NL1),U,P)=""
End DoDot:1
+25 QUIT
