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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRS2B 1821 printed Dec 13, 2024@02:00:21 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
