GMTSRS1B ; SLC/KER - Component Structure Resequence 2 ; 02/11/2003
;;2.7;Health Summary;**62**;Oct 20, 1995
;
Q
RES(ARY) ; Reset Input Array - .ARY
N GMTSI,GMTSC,GMTSI2,GMTSC2,GMTS S (GMTSI,GMTSC)=0
F S GMTSI=$O(ARY(GMTSI)) Q:+GMTSI=0 D
. S:$L($G(ARY(GMTSI))) GMTS(GMTSI)=$G(ARY(GMTSI))
. S:$L($G(ARY(GMTSI,0))) GMTS(GMTSI,0)=$G(ARY(GMTSI,0))
. S GMTSC=0 F S GMTSC=$O(ARY(GMTSI,GMTSC)) Q:+GMTSC=0 D
. . I +GMTSC=0 S GMTS(GMTSI,0)=$G(ARY(GMTSI,+GMTSC)) Q
. . S GMTS(GMTSI,GMTSC)=$G(ARY(GMTSI,GMTSC))
S (GMTSI,GMTSC,GMTSI2,GMTSC2)=0 K ARY
F S GMTSI=$O(GMTS(GMTSI)) Q:+GMTSI=0 D
. S GMTSI2=+($G(GMTSI2))+1 S:$L($G(GMTS(GMTSI))) ARY(GMTSI2)=$G(GMTS(GMTSI))
. S:$L($G(GMTS(GMTSI,0))) ARY(GMTSI2,0)=$G(GMTS(GMTSI,0))
. S (GMTSC,GMTSC2)=0 F S GMTSC=$O(GMTS(GMTSI,GMTSC)) Q:+GMTSC=0 D
. . S GMTSC2=+($G(GMTSC2))+1,ARY(GMTSI2,GMTSC2)=$G(GMTS(GMTSI,GMTSC))
Q
;
DIS(ARY) ; Display Array - .ARY
N GMTSI,GMTSCMP S GMTSI=0
F S GMTSI=$O(ARY(GMTSI)) Q:+GMTSI=0 D
. S GMTSCMP=$G(ARY(GMTSI)) W !,$J(GMTSI,4)," ",GMTSCMP
Q
;
INA(GMTST,ARY) ; Creates Input Array
N DA,GMTSS,GMTSC,GMTSI,GMTSVAL,GMTSPTR,GMTSFRT,GMTSCRT,GMTSFFRT
N GMTSFCRT,GMTSRT,GMTSUB,GMTSTYP,GMTSNN,GMTSNC,GMTSNR,GMTSCMP
N GMTSCMPI,GMTSND,GMTSNE
S DA(1)=+($G(GMTST)) Q:+DA(1)'>0 Q:'$D(^GMT(142,+DA(1)))
S (GMTSS,GMTSC,GMTSI)=0 F S GMTSI=$O(^GMT(142,DA(1),1,GMTSI)) Q:+GMTSI=0 D
. S GMTSVAL=$G(^GMT(142,DA(1),1,GMTSI,0)),GMTSCMPI=+($P(GMTSVAL,"^",2))
. K ^GMT(142,"AE",+GMTSCMPI,DA(1),GMTSI) S GMTSCMP=$P($G(^GMT(142.1,+GMTSCMPI,0)),"^",9)
. S:'$L(GMTSCMP) GMTSCMP=$E($P($G(^GMT(142.1,+($P(GMTSVAL,"^",2)),0)),"^",1),1,20)
. Q:'$L(GMTSCMP) S GMTSS=+($G(GMTSS))+1,ARY(GMTSS)=GMTSCMP,INA(GMTSS)=GMTSCMP
. S ARY(GMTSS,0)="^GMT(142,DA(2),1,DA(1),0)=(DA(1)_""^"_$P(GMTSVAL,"^",2,299)_""")"
. S INA(GMTSS,0)="^GMT(142,DA(2),1,DA(1),0)=(DA(1)_""^"_$P(GMTSVAL,"^",2,299)_""")"
. S DA=GMTSI,GMTSNN="^GMT(142,"_DA(1)_",1,"_DA_",1)",GMTSNC="^GMT(142,"_DA(1)_",1,"_DA_",1,"
. S GMTSC=0 F S GMTSNN=$Q(@GMTSNN) Q:'$L(GMTSNN)!(GMTSNN'[GMTSNC) D
. . S GMTSNR="^GMT(142,DA(2),1,DA(1),1,",GMTSNE=$P(GMTSNN,",",6,299)
. . S:$E(GMTSNE,1)="0" GMTSNR=GMTSNR_"0)" S:+GMTSNE>0 GMTSNR=GMTSNR_"DA,"_$P(GMTSNE,",",2,299)
. . Q:+GMTSNE'>0&($E(GMTSNE,1)'="0") S GMTSND=""""_@GMTSNN_"""",GMTSC=+($G(GMTSC))+1
. . S ARY(GMTSS,GMTSC)=GMTSNR_"="_GMTSND,INA(GMTSS,GMTSC)=GMTSNR_"="_GMTSND
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRS1B 2412 printed Dec 13, 2024@02:00:19 Page 2
GMTSRS1B ; SLC/KER - Component Structure Resequence 2 ; 02/11/2003
+1 ;;2.7;Health Summary;**62**;Oct 20, 1995
+2 ;
+3 QUIT
RES(ARY) ; Reset Input Array - .ARY
+1 NEW GMTSI,GMTSC,GMTSI2,GMTSC2,GMTS
SET (GMTSI,GMTSC)=0
+2 FOR
SET GMTSI=$ORDER(ARY(GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+3 if $LENGTH($GET(ARY(GMTSI)))
SET GMTS(GMTSI)=$GET(ARY(GMTSI))
+4 if $LENGTH($GET(ARY(GMTSI,0)))
SET GMTS(GMTSI,0)=$GET(ARY(GMTSI,0))
+5 SET GMTSC=0
FOR
SET GMTSC=$ORDER(ARY(GMTSI,GMTSC))
if +GMTSC=0
QUIT
Begin DoDot:2
+6 IF +GMTSC=0
SET GMTS(GMTSI,0)=$GET(ARY(GMTSI,+GMTSC))
QUIT
+7 SET GMTS(GMTSI,GMTSC)=$GET(ARY(GMTSI,GMTSC))
End DoDot:2
End DoDot:1
+8 SET (GMTSI,GMTSC,GMTSI2,GMTSC2)=0
KILL ARY
+9 FOR
SET GMTSI=$ORDER(GMTS(GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+10 SET GMTSI2=+($GET(GMTSI2))+1
if $LENGTH($GET(GMTS(GMTSI)))
SET ARY(GMTSI2)=$GET(GMTS(GMTSI))
+11 if $LENGTH($GET(GMTS(GMTSI,0)))
SET ARY(GMTSI2,0)=$GET(GMTS(GMTSI,0))
+12 SET (GMTSC,GMTSC2)=0
FOR
SET GMTSC=$ORDER(GMTS(GMTSI,GMTSC))
if +GMTSC=0
QUIT
Begin DoDot:2
+13 SET GMTSC2=+($GET(GMTSC2))+1
SET ARY(GMTSI2,GMTSC2)=$GET(GMTS(GMTSI,GMTSC))
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
DIS(ARY) ; Display Array - .ARY
+1 NEW GMTSI,GMTSCMP
SET GMTSI=0
+2 FOR
SET GMTSI=$ORDER(ARY(GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+3 SET GMTSCMP=$GET(ARY(GMTSI))
WRITE !,$JUSTIFY(GMTSI,4)," ",GMTSCMP
End DoDot:1
+4 QUIT
+5 ;
INA(GMTST,ARY) ; Creates Input Array
+1 NEW DA,GMTSS,GMTSC,GMTSI,GMTSVAL,GMTSPTR,GMTSFRT,GMTSCRT,GMTSFFRT
+2 NEW GMTSFCRT,GMTSRT,GMTSUB,GMTSTYP,GMTSNN,GMTSNC,GMTSNR,GMTSCMP
+3 NEW GMTSCMPI,GMTSND,GMTSNE
+4 SET DA(1)=+($GET(GMTST))
if +DA(1)'>0
QUIT
if '$DATA(^GMT(142,+DA(1)))
QUIT
+5 SET (GMTSS,GMTSC,GMTSI)=0
FOR
SET GMTSI=$ORDER(^GMT(142,DA(1),1,GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+6 SET GMTSVAL=$GET(^GMT(142,DA(1),1,GMTSI,0))
SET GMTSCMPI=+($PIECE(GMTSVAL,"^",2))
+7 KILL ^GMT(142,"AE",+GMTSCMPI,DA(1),GMTSI)
SET GMTSCMP=$PIECE($GET(^GMT(142.1,+GMTSCMPI,0)),"^",9)
+8 if '$LENGTH(GMTSCMP)
SET GMTSCMP=$EXTRACT($PIECE($GET(^GMT(142.1,+($PIECE(GMTSVAL,"^",2)),0)),"^",1),1,20)
+9 if '$LENGTH(GMTSCMP)
QUIT
SET GMTSS=+($GET(GMTSS))+1
SET ARY(GMTSS)=GMTSCMP
SET INA(GMTSS)=GMTSCMP
+10 SET ARY(GMTSS,0)="^GMT(142,DA(2),1,DA(1),0)=(DA(1)_""^"_$PIECE(GMTSVAL,"^",2,299)_""")"
+11 SET INA(GMTSS,0)="^GMT(142,DA(2),1,DA(1),0)=(DA(1)_""^"_$PIECE(GMTSVAL,"^",2,299)_""")"
+12 SET DA=GMTSI
SET GMTSNN="^GMT(142,"_DA(1)_",1,"_DA_",1)"
SET GMTSNC="^GMT(142,"_DA(1)_",1,"_DA_",1,"
+13 SET GMTSC=0
FOR
SET GMTSNN=$QUERY(@GMTSNN)
if '$LENGTH(GMTSNN)!(GMTSNN'[GMTSNC)
QUIT
Begin DoDot:2
+14 SET GMTSNR="^GMT(142,DA(2),1,DA(1),1,"
SET GMTSNE=$PIECE(GMTSNN,",",6,299)
+15 if $EXTRACT(GMTSNE,1)="0"
SET GMTSNR=GMTSNR_"0)"
if +GMTSNE>0
SET GMTSNR=GMTSNR_"DA,"_$PIECE(GMTSNE,",",2,299)
+16 if +GMTSNE'>0&($EXTRACT(GMTSNE,1)'="0")
QUIT
SET GMTSND=""""_@GMTSNN_""""
SET GMTSC=+($GET(GMTSC))+1
+17 SET ARY(GMTSS,GMTSC)=GMTSNR_"="_GMTSND
SET INA(GMTSS,GMTSC)=GMTSNR_"="_GMTSND
End DoDot:2
End DoDot:1
+18 QUIT
