Routine: GMTSRS2B

GMTSRS2B ; SLC/KER - Selection Items Resequence 2     ; 02/11/2003 [11/14/03 2:27pm]

 ;;2.7;Health Summary;**62,69**;Oct 20, 1995

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)

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRS2B   1821     printed  Apr 23, 2025@18:14:48                                                                                                                                                                                                    Page 2

GMTSRS2B  ; SLC/KER - Selection Items Resequence 2     ; 02/11/2003 [11/14/03 2:27pm]

 +1       ;;2.7;Health Summary;**62,69**;Oct 20, 1995

 +2       ;

 +3        QUIT

RES(ARY)  ; Reset Input Array - .ARY

 +1        NEW GMTSI,GMTSC

           SET (GMTSI,GMTSC)=0

FOR

               SET GMTSI=$ORDER(ARY(GMTSI))

               if +GMTSI=0

                   QUIT

               SET ^TMP("GMTSRS",$JOB,GMTSI)=$GET(ARY(GMTSI))

               SET ^TMP("GMTSRS",$JOB,GMTSI,1)=$GET(ARY(GMTSI,1))

 +2        KILL ARY

FOR

               SET GMTSI=$ORDER(^TMP("GMTSRS",$JOB,GMTSI))

               if +GMTSI=0

                   QUIT

               SET GMTSC=GMTSC+1

               SET ARY(GMTSC)=$GET(^TMP("GMTSRS",$JOB,GMTSI))

               SET ARY(GMTSC,1)=$GET(^TMP("GMTSRS",$JOB,GMTSI,1))

 +3        KILL ^TMP("GMTSRS",$JOB)

 +4        QUIT

DIS(ARY)  ; Display Array - .ARY

 +1        NEW GMTSI,GMTSTY,GMTSSM

           SET GMTSI=0

FOR

               SET GMTSI=$ORDER(ARY(GMTSI))

               if +GMTSI=0

                   QUIT

               SET GMTSTY=$PIECE($GET(ARY(GMTSI,1)),"^",1)

               SET GMTSSM=$PIECE($GET(ARY(GMTSI,1)),"^",2)

               Begin DoDot:1

 +2                WRITE !,$JUSTIFY(GMTSI,4),"  ",GMTSTY,", ",GMTSSM

               End DoDot:1

 +3        QUIT

 +4       ;

INA(GMTST,GMTSS,ARY) ; Creates Input Array

 +1        NEW DA,GMTSC,GMTSI,GMTSVAL,GMTSPTR,GMTSFRT,GMTSCRT,GMTSFFRT,GMTSFCRT

 +2        NEW GMTSRT,GMTSUB,GMTSTYP

 +3        SET DA(2)=+($GET(GMTST))

           if +DA(2)'>0

               QUIT

           if '$DATA(^GMT(142,+DA(2)))

               QUIT

 +4        SET DA(1)=+($GET(GMTSS))

           if +DA(1)'>0

               QUIT

           if '$DATA(^GMT(142,+DA(2),1,+DA(1)))

               QUIT

 +5        SET (GMTSC,GMTSI)=0

FOR

               SET GMTSI=$ORDER(^GMT(142,DA(2),1,DA(1),1,GMTSI))

               if +GMTSI=0

                   QUIT

               Begin DoDot:1

 +6                SET GMTSVAL=$GET(^GMT(142,DA(2),1,DA(1),1,GMTSI,0))

 +7                SET GMTSPTR=+GMTSVAL

                   SET GMTSFRT=$PIECE(GMTSVAL,";",2)

 +8                if GMTSFRT'["("

                       QUIT

                   if GMTSFRT'["^"

                       SET GMTSFRT="^"_GMTSFRT

 +9                SET GMTSCRT=$$CREF^DILF(GMTSFRT)

 +10               SET GMTSFFRT=GMTSFRT_GMTSPTR_","

 +11               SET GMTSFCRT=$$CREF^DILF(GMTSFFRT)

 +12               if '$DATA(@GMTSFCRT)

                       QUIT

                   if '$LENGTH($GET(@($PIECE(GMTSFCRT,")",1)_",0)")))

                       QUIT

 +13               SET GMTSUB=$PIECE($GET(@($PIECE(GMTSFCRT,")",1)_",0)")),"^",1)

 +14               IF GMTSCRT'["("

                       Begin DoDot:2

 +15                       SET GMTSTYP=$PIECE(@($PIECE(GMTSCRT,")",1)_"(0)"),"^",1)

                           SET GMTSC=GMTSC+1

                       End DoDot:2

 +16               IF GMTSCRT["("

                       Begin DoDot:2

 +17                       SET GMTSTYP=$PIECE(@($PIECE(GMTSCRT,")",1)_",0)"),"^",1)

                           SET GMTSC=GMTSC+1

                       End DoDot:2

 +18               SET GMTSRT=$TRANSLATE(GMTSFRT,"^","")

 +19               SET ARY(GMTSC)=GMTSPTR_";"_GMTSRT

                   SET ARY(GMTSC,1)=GMTSTYP_"^"_GMTSUB

 +20               SET INA(GMTSC)=GMTSPTR_";"_GMTSRT

                   SET INA(GMTSC,1)=GMTSTYP_"^"_GMTSUB

               End DoDot:1

 +21       QUIT

GMTSRS2B.m