ENARG22 ;(WASH ISC)/JED/DH-Archive 2162 ;12-16-92
;;7.0;ENGINEERING;;Aug 17, 1993
2 ;FSA
S %X="^ENG(""FSA"",Z,",%Y="^ENAR(6919.2,J,"
21 S J=$O(^ENAR(6919.2,J)) I J'?1N.N S $P(^ENG("FSA",0),U,4)=$P(^ENG("FSA",0),U,4)-I Q
W:I#5=0 "." S Z=$P(^ENAR(6919.2,J,0),U,1) D %XY^%RCR
S (Z(1),Z(2),Z(3),Z(3,1),Z(4))=0,Z(0)=$P(^ENAR(6919.2,J,0),U,1),Z(1)=ENSTA_"-"_Z(0)
S:$D(^ENAR(6919.2,J,3)) Z(2)=$P(^(3),U,6),Z(3)=$P(^(3),U,7) S:$D(^(4)) Z(4)=$P(^(4),U,5)
I Z(2)>0,$D(^DIC(6924.1,Z(2),0)) S Z(2)=$P(^(0),U,1)
I Z(3)>0,$D(^DIC(6924.3,Z(3),0)) S Z(3)=$P(^(0),U,1),Z(3,1)=$P(^(0),U,2)
I Z(4)>0,$D(^DIC(6924.2,Z(4),0)) S Z(4)=$P(^(0),U,1)
S $P(^ENAR(6919.2,J,0),U,1)=Z(1),$P(^(3),U,6,8)=Z(2)_U_Z(3)_U_Z(3,1),$P(^(4),U,5)=Z(4),^ENAR(6919.2,"B",Z(1),J)=""
S EN("C")=$P(^ENG("FSA",Z,0),U,2),(EN("D"),EN("E"))="" S:$D(^(1)) EN("D")=$P(^(1),U,1),EN("E")=$P(^(1),U,3)
;S I=I+1 G 21 ;Preserve data for test purposes
K ^ENG("FSA","B",Z(0),Z) K:EN("C")'="" ^ENG("FSA","C",EN("C"),Z) K:EN("D")'="" ^ENG("FSA","D",EN("D"),Z)
K:EN("E")'="" ^ENG("FSA","E",EN("E"),Z) K ^ENG("FSA",Z)
;S ^ENG("FSA",Z,0)="*"_Z(0),^ENG("FSA","B","*"_Z(0),Z)=""
S I=I+1 G 21
OUT K EN,ENA,ENB,I,J,K,X,X1,X2,Z,%X,%Y Q
;ENARG22
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENARG22 1213 printed Dec 13, 2024@01:51:35 Page 2
ENARG22 ;(WASH ISC)/JED/DH-Archive 2162 ;12-16-92
+1 ;;7.0;ENGINEERING;;Aug 17, 1993
2 ;FSA
+1 SET %X="^ENG(""FSA"",Z,"
SET %Y="^ENAR(6919.2,J,"
21 SET J=$ORDER(^ENAR(6919.2,J))
IF J'?1N.N
SET $PIECE(^ENG("FSA",0),U,4)=$PIECE(^ENG("FSA",0),U,4)-I
QUIT
+1 if I#5=0
WRITE "."
SET Z=$PIECE(^ENAR(6919.2,J,0),U,1)
DO %XY^%RCR
+2 SET (Z(1),Z(2),Z(3),Z(3,1),Z(4))=0
SET Z(0)=$PIECE(^ENAR(6919.2,J,0),U,1)
SET Z(1)=ENSTA_"-"_Z(0)
+3 if $DATA(^ENAR(6919.2,J,3))
SET Z(2)=$PIECE(^(3),U,6)
SET Z(3)=$PIECE(^(3),U,7)
if $DATA(^(4))
SET Z(4)=$PIECE(^(4),U,5)
+4 IF Z(2)>0
IF $DATA(^DIC(6924.1,Z(2),0))
SET Z(2)=$PIECE(^(0),U,1)
+5 IF Z(3)>0
IF $DATA(^DIC(6924.3,Z(3),0))
SET Z(3)=$PIECE(^(0),U,1)
SET Z(3,1)=$PIECE(^(0),U,2)
+6 IF Z(4)>0
IF $DATA(^DIC(6924.2,Z(4),0))
SET Z(4)=$PIECE(^(0),U,1)
+7 SET $PIECE(^ENAR(6919.2,J,0),U,1)=Z(1)
SET $PIECE(^(3),U,6,8)=Z(2)_U_Z(3)_U_Z(3,1)
SET $PIECE(^(4),U,5)=Z(4)
SET ^ENAR(6919.2,"B",Z(1),J)=""
+8 SET EN("C")=$PIECE(^ENG("FSA",Z,0),U,2)
SET (EN("D"),EN("E"))=""
if $DATA(^(1))
SET EN("D")=$PIECE(^(1),U,1)
SET EN("E")=$PIECE(^(1),U,3)
+9 ;S I=I+1 G 21 ;Preserve data for test purposes
+10 KILL ^ENG("FSA","B",Z(0),Z)
if EN("C")'=""
KILL ^ENG("FSA","C",EN("C"),Z)
if EN("D")'=""
KILL ^ENG("FSA","D",EN("D"),Z)
+11 if EN("E")'=""
KILL ^ENG("FSA","E",EN("E"),Z)
KILL ^ENG("FSA",Z)
+12 ;S ^ENG("FSA",Z,0)="*"_Z(0),^ENG("FSA","B","*"_Z(0),Z)=""
+13 SET I=I+1
GOTO 21
OUT KILL EN,ENA,ENB,I,J,K,X,X1,X2,Z,%X,%Y
QUIT
+1 ;ENARG22
