source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSRS1B.m@ 1226

Last change on this file since 1226 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1GMTSRS1B ; SLC/KER - Component Structure Resequence 2 ; 02/11/2003
2 ;;2.7;Health Summary;**62**;Oct 20, 1995
3 ;
4 Q
5RES(ARY) ; Reset Input Array - .ARY
6 N GMTSI,GMTSC,GMTSI2,GMTSC2,GMTS S (GMTSI,GMTSC)=0
7 F S GMTSI=$O(ARY(GMTSI)) Q:+GMTSI=0 D
8 . S:$L($G(ARY(GMTSI))) GMTS(GMTSI)=$G(ARY(GMTSI))
9 . S:$L($G(ARY(GMTSI,0))) GMTS(GMTSI,0)=$G(ARY(GMTSI,0))
10 . S GMTSC=0 F S GMTSC=$O(ARY(GMTSI,GMTSC)) Q:+GMTSC=0 D
11 . . I +GMTSC=0 S GMTS(GMTSI,0)=$G(ARY(GMTSI,+GMTSC)) Q
12 . . S GMTS(GMTSI,GMTSC)=$G(ARY(GMTSI,GMTSC))
13 S (GMTSI,GMTSC,GMTSI2,GMTSC2)=0 K ARY
14 F S GMTSI=$O(GMTS(GMTSI)) Q:+GMTSI=0 D
15 . S GMTSI2=+($G(GMTSI2))+1 S:$L($G(GMTS(GMTSI))) ARY(GMTSI2)=$G(GMTS(GMTSI))
16 . S:$L($G(GMTS(GMTSI,0))) ARY(GMTSI2,0)=$G(GMTS(GMTSI,0))
17 . S (GMTSC,GMTSC2)=0 F S GMTSC=$O(GMTS(GMTSI,GMTSC)) Q:+GMTSC=0 D
18 . . S GMTSC2=+($G(GMTSC2))+1,ARY(GMTSI2,GMTSC2)=$G(GMTS(GMTSI,GMTSC))
19 Q
20 ;
21DIS(ARY) ; Display Array - .ARY
22 N GMTSI,GMTSCMP S GMTSI=0
23 F S GMTSI=$O(ARY(GMTSI)) Q:+GMTSI=0 D
24 . S GMTSCMP=$G(ARY(GMTSI)) W !,$J(GMTSI,4)," ",GMTSCMP
25 Q
26 ;
27INA(GMTST,ARY) ; Creates Input Array
28 N DA,GMTSS,GMTSC,GMTSI,GMTSVAL,GMTSPTR,GMTSFRT,GMTSCRT,GMTSFFRT
29 N GMTSFCRT,GMTSRT,GMTSUB,GMTSTYP,GMTSNN,GMTSNC,GMTSNR,GMTSCMP
30 N GMTSCMPI,GMTSND,GMTSNE
31 S DA(1)=+($G(GMTST)) Q:+DA(1)'>0 Q:'$D(^GMT(142,+DA(1)))
32 S (GMTSS,GMTSC,GMTSI)=0 F S GMTSI=$O(^GMT(142,DA(1),1,GMTSI)) Q:+GMTSI=0 D
33 . S GMTSVAL=$G(^GMT(142,DA(1),1,GMTSI,0)),GMTSCMPI=+($P(GMTSVAL,"^",2))
34 . K ^GMT(142,"AE",+GMTSCMPI,DA(1),GMTSI) S GMTSCMP=$P($G(^GMT(142.1,+GMTSCMPI,0)),"^",9)
35 . S:'$L(GMTSCMP) GMTSCMP=$E($P($G(^GMT(142.1,+($P(GMTSVAL,"^",2)),0)),"^",1),1,20)
36 . Q:'$L(GMTSCMP) S GMTSS=+($G(GMTSS))+1,ARY(GMTSS)=GMTSCMP,INA(GMTSS)=GMTSCMP
37 . S ARY(GMTSS,0)="^GMT(142,DA(2),1,DA(1),0)=(DA(1)_""^"_$P(GMTSVAL,"^",2,299)_""")"
38 . S INA(GMTSS,0)="^GMT(142,DA(2),1,DA(1),0)=(DA(1)_""^"_$P(GMTSVAL,"^",2,299)_""")"
39 . S DA=GMTSI,GMTSNN="^GMT(142,"_DA(1)_",1,"_DA_",1)",GMTSNC="^GMT(142,"_DA(1)_",1,"_DA_",1,"
40 . S GMTSC=0 F S GMTSNN=$Q(@GMTSNN) Q:'$L(GMTSNN)!(GMTSNN'[GMTSNC) D
41 . . S GMTSNR="^GMT(142,DA(2),1,DA(1),1,",GMTSNE=$P(GMTSNN,",",6,299)
42 . . S:$E(GMTSNE,1)="0" GMTSNR=GMTSNR_"0)" S:+GMTSNE>0 GMTSNR=GMTSNR_"DA,"_$P(GMTSNE,",",2,299)
43 . . Q:+GMTSNE'>0&($E(GMTSNE,1)'="0") S GMTSND=""""_@GMTSNN_"""",GMTSC=+($G(GMTSC))+1
44 . . S ARY(GMTSS,GMTSC)=GMTSNR_"="_GMTSND,INA(GMTSS,GMTSC)=GMTSNR_"="_GMTSND
45 Q
Note: See TracBrowser for help on using the repository browser.