Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMTSRS2B

GMTSRS2B.m

Go to the documentation of this file.
GMTSRS2B ; SLC/KER - Selection Items Resequence 2     ; 02/11/2003 [11/14/03 2:27pm]
 ;;2.7;Health Summary;**62,69**;Oct 20, 1995
 ;
 Q
RES(ARY) ; Reset Input Array - .ARY
 N GMTSI,GMTSC S (GMTSI,GMTSC)=0 F  S GMTSI=$O(ARY(GMTSI)) Q:+GMTSI=0  S ^TMP("GMTSRS",$J,GMTSI)=$G(ARY(GMTSI)),^TMP("GMTSRS",$J,GMTSI,1)=$G(ARY(GMTSI,1))
 K ARY F  S GMTSI=$O(^TMP("GMTSRS",$J,GMTSI)) Q:+GMTSI=0  S GMTSC=GMTSC+1,ARY(GMTSC)=$G(^TMP("GMTSRS",$J,GMTSI)),ARY(GMTSC,1)=$G(^TMP("GMTSRS",$J,GMTSI,1))
 K ^TMP("GMTSRS",$J)
 Q
DIS(ARY) ; Display Array - .ARY
 N GMTSI,GMTSTY,GMTSSM S GMTSI=0 F  S GMTSI=$O(ARY(GMTSI)) Q:+GMTSI=0  S GMTSTY=$P($G(ARY(GMTSI,1)),"^",1),GMTSSM=$P($G(ARY(GMTSI,1)),"^",2) D
 . W !,$J(GMTSI,4),"  ",GMTSTY,", ",GMTSSM
 Q
 ;
INA(GMTST,GMTSS,ARY) ; Creates Input Array
 N DA,GMTSC,GMTSI,GMTSVAL,GMTSPTR,GMTSFRT,GMTSCRT,GMTSFFRT,GMTSFCRT
 N GMTSRT,GMTSUB,GMTSTYP
 S DA(2)=+($G(GMTST)) Q:+DA(2)'>0  Q:'$D(^GMT(142,+DA(2)))
 S DA(1)=+($G(GMTSS)) Q:+DA(1)'>0  Q:'$D(^GMT(142,+DA(2),1,+DA(1)))
 S (GMTSC,GMTSI)=0 F  S GMTSI=$O(^GMT(142,DA(2),1,DA(1),1,GMTSI)) Q:+GMTSI=0  D
 . S GMTSVAL=$G(^GMT(142,DA(2),1,DA(1),1,GMTSI,0))
 . S GMTSPTR=+GMTSVAL,GMTSFRT=$P(GMTSVAL,";",2)
 . Q:GMTSFRT'["("  S:GMTSFRT'["^" GMTSFRT="^"_GMTSFRT
 . S GMTSCRT=$$CREF^DILF(GMTSFRT)
 . S GMTSFFRT=GMTSFRT_GMTSPTR_","
 . S GMTSFCRT=$$CREF^DILF(GMTSFFRT)
 . Q:'$D(@GMTSFCRT)  Q:'$L($G(@($P(GMTSFCRT,")",1)_",0)")))
 . S GMTSUB=$P($G(@($P(GMTSFCRT,")",1)_",0)")),"^",1)
 . I GMTSCRT'["(" D
 . . S GMTSTYP=$P(@($P(GMTSCRT,")",1)_"(0)"),"^",1),GMTSC=GMTSC+1
 . I GMTSCRT["(" D
 . . S GMTSTYP=$P(@($P(GMTSCRT,")",1)_",0)"),"^",1),GMTSC=GMTSC+1
 . S GMTSRT=$TR(GMTSFRT,"^","")
 . S ARY(GMTSC)=GMTSPTR_";"_GMTSRT,ARY(GMTSC,1)=GMTSTYP_"^"_GMTSUB
 . S INA(GMTSC)=GMTSPTR_";"_GMTSRT,INA(GMTSC,1)=GMTSTYP_"^"_GMTSUB
 Q