- 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 Apr 23, 2025@18:14:46 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
