XQORMX.m

XQORMX ; SLC/KCM - Compile Formatted Menus ;2/3/94  09:58 ; [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;8.0;KERNEL;;Jul 10, 1995

SET ;From: XQORM (when navigating file 19)  Entry: DA  Exit: DA

 ;NOTE:  Lock ^DIC(19,DA) when calling

 N X I $D(^XUTL("XQORM",DA_";DIC(19,",0)),$D(^DIC(19,DA,99)),($P(^DIC(19,DA,99),"^",1)=$P(^XUTL("XQORM",DA_";DIC(19,",0),"^",1)) Q

 K ^TMP("XQORM",$J),^XUTL("XQORM",DA_";DIC(19,")

 S ORMN=1,^XUTL("XQORM",DA_";DIC(19,","COL")=ORMN,ORMT=0

 F ORM=0:0 S ORM=$O(^DIC(19,DA,10,ORM)) Q:ORM'>0  I $D(^DIC(19,DA,10,ORM,0)) S ORMX=^(0) D ORD

 S ORM=ORMT\ORMN S:ORMT#ORMN ORM=ORM+1 S ORMT=ORM,ORMC=.1

 S ORMI="" F ORM=0:0 S ORMI=$O(^TMP("XQORM",$J,ORMI)) Q:ORMI=""  F ORM=0:0 S ORM=$O(^TMP("XQORM",$J,ORMI,ORM)) Q:ORM'>0  I $D(^DIC(19,DA,10,ORM,0)) S ORMX=^(0),ORMC=$S((ORMC\1)'<ORMT:1+($P(ORMC,".",2)/10)+.1,1:ORMC+1) D BILD

 I $D(^DIC(19,DA,99)) S ORM=$P(^(99),"^",1),^XUTL("XQORM",DA_";DIC(19,",0)=ORM

 K ORM,ORMX,ORMN,ORMT,ORMC,ORMI,^TMP("XQORM",$J) Q

ORD S ORMI=$S(+$P(ORMX,"^",3):+$P(ORMX,"^",3),+$P(ORMX,"^",2):+$P(ORMX,"^",2),$L($P(ORMX,"^",2)):"M"_$P(ORMX,"^",2),1:"Z"_$S($D(^DIC(19,+$P(ORMX,"^",1),0)):$P(^(0),"^",2),1:"")) S ^TMP("XQORM",$J,ORMI,ORM)="",ORMT=ORMT+1

 Q

BILD S X=$S($D(^DIC(19,+$P(ORMX,"^",1),0)):$P(^(0),"^",2),1:"")

 F %=1:1:$L(X) I ",=;-"[$E(X,%) S X=$E(X,1,%-1)_" "_$E(X,%+1,999)

 S ^XUTL("XQORM",DA_";DIC(19,",ORMC,0)=ORM_"^"_$P(ORMX,"^",1)_"^"_X_"^"_$P(ORMX,"^",2)

 I $L(X) D UP S ^XUTL("XQORM",DA_";DIC(19,","B",X,ORMC)=""

 S X=$P(ORMX,"^",2) I $L(X) D UP S ^XUTL("XQORM",DA_";DIC(19,","B",X,ORMC)=1

 Q

UP F %=1:1:$L(X) I $E(X,%)?1L S X=$E(X,1,%-1)_$C($A(X,%)-32)_$E(X,%+1,99)

 Q

XQORMX    ; SLC/KCM - Compile Formatted Menus ;2/3/94  09:58 ; [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;;Jul 10, 1995

SET       ;From: XQORM (when navigating file 19)  Entry: DA  Exit: DA

 +1       ;NOTE:  Lock ^DIC(19,DA) when calling

 +2        NEW X

           IF $DATA(^XUTL("XQORM",DA_";DIC(19,",0))

               IF $DATA(^DIC(19,DA,99))

                   IF ($PIECE(^DIC(19,DA,99),"^",1)=$PIECE(^XUTL("XQORM",DA_";DIC(19,",0),"^",1))

                       QUIT 

 +3        KILL ^TMP("XQORM",$JOB),^XUTL("XQORM",DA_";DIC(19,")

 +4        SET ORMN=1

           SET ^XUTL("XQORM",DA_";DIC(19,","COL")=ORMN

           SET ORMT=0

 +5        FOR ORM=0:0

               SET ORM=$ORDER(^DIC(19,DA,10,ORM))

               IF ORM'>0

                   QUIT 

               IF $DATA(^DIC(19,DA,10,ORM,0))

                   SET ORMX=^(0)

                   DO ORD

 +6        SET ORM=ORMT\ORMN

           IF ORMT#ORMN

               SET ORM=ORM+1

           SET ORMT=ORM

           SET ORMC=.1

 +7        SET ORMI=""

           FOR ORM=0:0

               SET ORMI=$ORDER(^TMP("XQORM",$JOB,ORMI))

               IF ORMI=""

                   QUIT 

               FOR ORM=0:0

                   SET ORM=$ORDER(^TMP("XQORM",$JOB,ORMI,ORM))

                   IF ORM'>0

                       QUIT 

                   IF $DATA(^DIC(19,DA,10,ORM,0))

                       SET ORMX=^(0)

                       SET ORMC=$SELECT((ORMC\1)'<ORMT:1+($PIECE(ORMC,".",2)/10)+.1,1:ORMC+1)

                       DO BILD

 +8        IF $DATA(^DIC(19,DA,99))

               SET ORM=$PIECE(^(99),"^",1)

               SET ^XUTL("XQORM",DA_";DIC(19,",0)=ORM

 +9        KILL ORM,ORMX,ORMN,ORMT,ORMC,ORMI,^TMP("XQORM",$JOB)

           QUIT 

ORD        SET ORMI=$SELECT(+$PIECE(ORMX,"^",3):+$PIECE(ORMX,"^",3),+$PIECE(ORMX,"^",2):+$PIECE(ORMX,"^",2),$LENGTH($PIECE(ORMX,"^",2)):"M"_$PIECE(ORMX,"^",2),1:"Z"_$SELECT($DATA(^DIC(19,+$PIECE(ORMX,"^",1),0)):$PIECE(^(0),"^",2),1:""))

           SET ^TMP("XQORM",$JOB,ORMI,ORM)=""

           SET ORMT=ORMT+1

 +1        QUIT 

BILD       SET X=$SELECT($DATA(^DIC(19,+$PIECE(ORMX,"^",1),0)):$PIECE(^(0),"^",2),1:"")

 +1        FOR %=1:1:$LENGTH(X)

               IF ",=;-"[$EXTRACT(X,%)

                   SET X=$EXTRACT(X,1,%-1)_" "_$EXTRACT(X,%+1,999)

 +2        SET ^XUTL("XQORM",DA_";DIC(19,",ORMC,0)=ORM_"^"_$PIECE(ORMX,"^",1)_"^"_X_"^"_$PIECE(ORMX,"^",2)

 +3        IF $LENGTH(X)

               DO UP

               SET ^XUTL("XQORM",DA_";DIC(19,","B",X,ORMC)=""

 +4        SET X=$PIECE(ORMX,"^",2)

           IF $LENGTH(X)

               DO UP

               SET ^XUTL("XQORM",DA_";DIC(19,","B",X,ORMC)=1

 +5        QUIT 

UP         FOR %=1:1:$LENGTH(X)

               IF $EXTRACT(X,%)?1L

                   SET X=$EXTRACT(X,1,%-1)_$CHAR($ASCII(X,%)-32)_$EXTRACT(X,%+1,99)

 +1        QUIT