- VALMXQ14 ; alb/mjk - XQORMX for export with LM v1 ; 3/30/93
- ;;1;List Manager;;Aug 13, 1993
- ;
- ;
- XQORMX ; SLC/KCM - Build formatted menus ; 5/2/89 14:55 ;
- ;;6.7;Sidewinder;;Jan 08, 1993
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVALMXQ14 1720 printed Jan 18, 2025@03:11:45 Page 2
- VALMXQ14 ; alb/mjk - XQORMX for export with LM v1 ; 3/30/93
- +1 ;;1;List Manager;;Aug 13, 1993
- +2 ;
- +3 ;
- XQORMX ; SLC/KCM - Build formatted menus ; 5/2/89 14:55 ;
- +1 ;;6.7;Sidewinder;;Jan 08, 1993
- 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