Routine: ORGUEM1

ORGUEM1 ; slc/KCM - Build menu in seq #, name format ;2/5/92 17:16;

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997

SET(DA) ;From: ORGUEM Entry: DA  Exit: DA

 I $L($G(^ORD(101,DA,99))),$P($G(^(99)),"^")=$P($G(^XUTL("XQORM",DA_";"_$J,0)),"^") Q

 N ORCOL,ORCCOL,ORROW,ORCROW,ORPOS,ORTOT,S1,S2,X,X1

 K ^TMP("XQORM",$J) D KILL

 S ORCOL=1 I $P($G(^ORD(101,DA,4)),"^")>0 S ORCOL=80\$P(^(4),"^",1)

 S ^XUTL("XQORM",DA_";"_$J,"COL")=ORCOL,(ORTOT,S2)=0

 F  S S2=$O(^ORD(101,DA,10,S2)) Q:S2'>0  D

 . S X=^ORD(101,DA,10,S2,0)

 . S X=$S(+$P(X,"^",3):+$P(X,"^",3),+$P(X,"^",2):+$P(X,"^",2),$L($P(X,"^",2)):"M"_$P(X,"^",2),1:"Z"_$P(^ORD(101,+X,0),"^",2))

 . S ^TMP("XQORM",$J,X,S2)="",ORTOT=ORTOT+1

 S ORROW=ORTOT\ORCOL+$S(ORTOT#ORCOL:1,1:0),ORCCOL=1,ORCROW=0,S1=""

 F  S S1=$O(^TMP("XQORM",$J,S1)) Q:S1=""  S S2=0 D      ;S1 is sequence (#,M_,Z_)

 . F  S S2=$O(^TMP("XQORM",$J,S1,S2))  Q:S2'>0  D       ;S2 is IEN of item multiple

 . . S X=^ORD(101,DA,10,S2,0)                           ;X is the item node

 . . I '$D(^ORD(101,+X,0)) K ^ORD(101,DA,10,S2),^("B",+X,S2) S $P(^ORD(101,DA,10,0),"^",3,4)=S2_"^"_($P(^ORD(101,DA,10,0),"^",4)-1) Q

 . . S ORCROW=ORCROW+1 I ORCROW>ORROW S ORCROW=1,ORCCOL=ORCCOL+1

 . . S ORPOS=ORCROW+(ORCCOL/10) D

 . . . S X1=$TR($P(^ORD(101,+X,0),"^"),",=;-","    ") Q:'$L(X1)

 . . . S ^XUTL("XQORM",DA_";"_$J,ORPOS,0)=S2_"^"_+X_"^"_$E(X1,1,80\ORCOL-5)_"^"_$P(X,"^",3)

 . . . S ^XUTL("XQORM",DA_";"_$J,"B",$$UP(X1),ORPOS)=""

 . . . I $L($P(X,"^",3)) S ^XUTL("XQORM",DA_";"_$J,"B",$$UP($P(X,"^",3)),ORPOS)=1

 S ^XUTL("XQORM",DA_";"_$J,0)=$G(^ORD(101,DA,99))

 K ^TMP("XQORM",$J)

UP(X) ;Convert X to upper case

 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

KILL ;From: File 101, Field 99  Entry: DA  Exit: DA

 K ^XUTL("XQORM",DA_";"_$J)

ORGUEM1   ; slc/KCM - Build menu in seq #, name format ;2/5/92 17:16;

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997

SET(DA)   ;From: ORGUEM Entry: DA  Exit: DA

 +1        IF $LENGTH($GET(^ORD(101,DA,99)))

               IF $PIECE($GET(^(99)),"^")=$PIECE($GET(^XUTL("XQORM",DA_";"_$JOB,0)),"^")

                   QUIT

 +2        NEW ORCOL,ORCCOL,ORROW,ORCROW,ORPOS,ORTOT,S1,S2,X,X1

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

           DO KILL

 +4        SET ORCOL=1

           IF $PIECE($GET(^ORD(101,DA,4)),"^")>0

               SET ORCOL=80\$PIECE(^(4),"^",1)

 +5        SET ^XUTL("XQORM",DA_";"_$JOB,"COL")=ORCOL

           SET (ORTOT,S2)=0

 +6        FOR

               SET S2=$ORDER(^ORD(101,DA,10,S2))

               IF S2'>0

                   QUIT

               Begin DoDot:1

 +7                SET X=^ORD(101,DA,10,S2,0)

 +8                SET X=$SELECT(+$PIECE(X,"^",3):+$PIECE(X,"^",3),+$PIECE(X,"^",2):+$PIECE(X,"^",2),$LENGTH($PIECE(X,"^",2)):"M"_$PIECE(X,"^",2),1:"Z"_$PIECE(^ORD(101,+X,0),"^",2))

 +9                SET ^TMP("XQORM",$JOB,X,S2)=""

                   SET ORTOT=ORTOT+1

               End DoDot:1

 +10       SET ORROW=ORTOT\ORCOL+$SELECT(ORTOT#ORCOL:1,1:0)

           SET ORCCOL=1

           SET ORCROW=0

           SET S1=""

 +11      ;S1 is sequence (#,M_,Z_)

FOR

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

               IF S1=""

                   QUIT

               SET S2=0

               Begin DoDot:1

 +12      ;S2 is IEN of item multiple

FOR

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

                       IF S2'>0

                           QUIT

                       Begin DoDot:2

 +13      ;X is the item node

                           SET X=^ORD(101,DA,10,S2,0)

 +14                       IF '$DATA(^ORD(101,+X,0))

                               KILL ^ORD(101,DA,10,S2),^("B",+X,S2)

                               SET $PIECE(^ORD(101,DA,10,0),"^",3,4)=S2_"^"_($PIECE(^ORD(101,DA,10,0),"^",4)-1)

                               QUIT

 +15                       SET ORCROW=ORCROW+1

                           IF ORCROW>ORROW

                               SET ORCROW=1

                               SET ORCCOL=ORCCOL+1

 +16                       SET ORPOS=ORCROW+(ORCCOL/10)

                           Begin DoDot:3

 +17                           SET X1=$TRANSLATE($PIECE(^ORD(101,+X,0),"^"),",=;-","    ")

                               IF '$LENGTH(X1)

                                   QUIT

 +18                           SET ^XUTL("XQORM",DA_";"_$JOB,ORPOS,0)=S2_"^"_+X_"^"_$EXTRACT(X1,1,80\ORCOL-5)_"^"_$PIECE(X,"^",3)

 +19                           SET ^XUTL("XQORM",DA_";"_$JOB,"B",$$UP(X1),ORPOS)=""

 +20                           IF $LENGTH($PIECE(X,"^",3))

                                   SET ^XUTL("XQORM",DA_";"_$JOB,"B",$$UP($PIECE(X,"^",3)),ORPOS)=1

                           End DoDot:3

                       End DoDot:2

               End DoDot:1

 +21       SET ^XUTL("XQORM",DA_";"_$JOB,0)=$GET(^ORD(101,DA,99))

 +22       KILL ^TMP("XQORM",$JOB)

 +23       QUIT

UP(X)     ;Convert X to upper case

 +1        QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

KILL      ;From: File 101, Field 99  Entry: DA  Exit: DA

 +1        KILL ^XUTL("XQORM",DA_";"_$JOB)

 +2        QUIT

ORGUEM1.m