ORGUEM.m

ORGUEM ; slc/KCM - Set Up Formatted Protocol Menus ;5/28/92 14:41

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

 ;;

EN ; Select menu, change items, formatting, & other attributes

 N ORGPOP,ORGMENU,IOINHI,IOINLOW                          ; ORGMENU declared globally for ORGUEM*

 D GMENU^ORGUEM2("AEMQL",.ORGMENU) Q:$D(ORGPOP)           ; Get protocol menu

 I $P(ORGMENU,"^",3) D NEW^ORGUEM2 I $D(ORGPOP) D DMEN Q  ; If creating a new protocol, get required fields

 D HOME^%ZIS S X="IOINHI;IOINLOW" D ENDR^%ZISS

 S ORGMENU("TOG")="F" D SHOW                      ; Show menu in formatted mode

 S X=$O(^ORD(101,"B","ORCL PROTOCOL MENU SETUP",0))_";ORD(101,"

 D EN^XQOR                                        ; Use XQOR to select & execute actions

 D BLANKS^ORGUEM2                                 ; Reset blank lines

 S ^DISV(DUZ,"^ORD(101,")=+ORGMENU

 K ^XUTL("XQORM",+ORGMENU_";"_$J)                 ; Clean up sequence/name menu node

 Q

DMEN ; Delete Protocol Menu (pointers not updated)

 N DA,DIK

 S DA=+ORGMENU,DIK="^ORD(101,"

 W !,"Insufficient information to create menu...."

 D ^DIK

 Q

COL ; Edit the number of columns for the protocol

 N ORCOL,DIR,DIC,DIE,DR,DA

 S ORCOL=80\$S($G(^ORD(101,+ORGMENU,4)):^(4),1:80)

 S DIR(0)="NAO^1:3",DIR("A")="Number of Columns (1-3): ",DIR("B")=ORCOL

 D ^DIR

 I Y,Y'=ORCOL S DR="41///"_(80\Y),DIE="^ORD(101,",DA=+ORGMENU D ^DIE

 Q

MNE ; Edit mnemonic width for the protocol

 N ORMNE,DIR,DIC,DIE,DR,DA

 S ORMNE=$P($G(^ORD(101,+ORGMENU,4)),"^",2)

 S DIR(0)="NAO^1:9",DIR("A")="Width for Mnemonics: ",DIR("B")=$S(ORMNE:ORMNE,1:5)

 D ^DIR

 I Y,Y'=ORMNE S DR="42///"_Y,DIE="^ORD(101,",DA=+ORGMENU D ^DIE

 Q

ADD ; Add a new item to the menu

 N DIC

 S DIC="^ORD(101,",DIC(0)="AEMQZ",DIC("A")="Select Item to be Added: "

 F  D ^DIC Q:Y'>0  D

 . N D0,DD,DIC,DA,DIE,DR

 . S:'$D(^ORD(101,+ORGMENU,10,0)) ^(0)="^101.01PA^^"

 . S X=+Y,DA(1)=+ORGMENU,DIC="^ORD(101,"_DA(1)_",10,",DIC(0)=""

 . D FILE^DICN I +Y S DIE=DIC,DA=+Y,DR="3;2;6" D ^DIE

 Q

EDIT ; Edit an item on the menu

 N ORGIDX,ORGLST,ORGFLG

 S ORGLST=$$LOOK^ORGUEM2("Select item(s) to be edited: ")

 F ORGIDX=1:1:$L(ORGLST,",") I +$P(ORGLST,",",ORGIDX) D FLDS^ORGUEM2(+$P(ORGLST,",",ORGIDX),.ORGFLG) Q:ORGFLG

 Q

DEL ; Delete an item from the menu

 N ORGIDX,ORGLST,DA,DIK

 S ORGLST=$$LOOK^ORGUEM2("Select item(s) to be deleted: ")

 F ORGIDX=1:1:$L(ORGLST,",") D  ;delete item

 . S DA=$P(ORGLST,",",ORGIDX)

 . I DA S DA(1)=+ORGMENU,DIK="^ORD(101,"_DA(1)_",10," D ^DIK

 Q

SHOW ; Display the menu

 N XQORM,X

 W !!,ORGMENU(0,0),?61,$$INHI^XQORM1,"HILITE",$$INLO^XQORM1,"=placeholder"

 W ! F I=1:1:79 W "-"

 D SMENU^ORGUEM2 D:ORGMENU("TOG")="R" SET^ORGUEM1(+ORGMENU) D EN^XQORM

 I ORGMENU("TOG")="F" D

 . W !,$S($D(XQORM("A")):XQORM("A"),1:"Select Item(s): ")

 . W:$D(XQORM("B")) XQORM("B")_"// "

 W ! F I=1:1:79 W "-"

 Q

TOG ; Toggle menu display mode

 I ORGMENU("TOG")="R" S ORGMENU("TOG")="F" W !,"Menus will now be displayed as the user will see them."

 E  S ORGMENU("TOG")="R" W !,"Menus will now be displayed using actual sequence numbers and protocol names."

 Q

OPT ; Edit optional menu parameters

 N DIE,DR,DA

 S DIE="^ORD(101,",DR="[ORCL ADV MENU EDIT]",DA=+ORGMENU D ^DIE

 Q

INQ ; Inquire protocol file

 N DIC,DA,DR,DIQ

 S DIC="^ORD(101,",DIC(0)="AEMQ" D ^DIC Q:Y'>0

 W ! S DA=+Y D EN^DIQ

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ORGUEM   3367     printed  Feb 18, 2025@23:57:25                                                                                                                                                                                                      Page 2

ORGUEM    ; slc/KCM - Set Up Formatted Protocol Menus ;5/28/92 14:41

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

 +2       ;;

EN        ; Select menu, change items, formatting, & other attributes

 +1       ; ORGMENU declared globally for ORGUEM*

           NEW ORGPOP,ORGMENU,IOINHI,IOINLOW

 +2       ; Get protocol menu

           DO GMENU^ORGUEM2("AEMQL",.ORGMENU)

           if $DATA(ORGPOP)

               QUIT 

 +3       ; If creating a new protocol, get required fields

           IF $PIECE(ORGMENU,"^",3)

               DO NEW^ORGUEM2

               IF $DATA(ORGPOP)

                   DO DMEN

                   QUIT 

 +4        DO HOME^%ZIS

           SET X="IOINHI;IOINLOW"

           DO ENDR^%ZISS

 +5       ; Show menu in formatted mode

           SET ORGMENU("TOG")="F"

           DO SHOW

 +6        SET X=$ORDER(^ORD(101,"B","ORCL PROTOCOL MENU SETUP",0))_";ORD(101,"

 +7       ; Use XQOR to select & execute actions

           DO EN^XQOR

 +8       ; Reset blank lines

           DO BLANKS^ORGUEM2

 +9        SET ^DISV(DUZ,"^ORD(101,")=+ORGMENU

 +10      ; Clean up sequence/name menu node

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

 +11       QUIT 

DMEN      ; Delete Protocol Menu (pointers not updated)

 +1        NEW DA,DIK

 +2        SET DA=+ORGMENU

           SET DIK="^ORD(101,"

 +3        WRITE !,"Insufficient information to create menu...."

 +4        DO ^DIK

 +5        QUIT 

COL       ; Edit the number of columns for the protocol

 +1        NEW ORCOL,DIR,DIC,DIE,DR,DA

 +2        SET ORCOL=80\$SELECT($GET(^ORD(101,+ORGMENU,4)):^(4),1:80)

 +3        SET DIR(0)="NAO^1:3"

           SET DIR("A")="Number of Columns (1-3): "

           SET DIR("B")=ORCOL

 +4        DO ^DIR

 +5        IF Y

               IF Y'=ORCOL

                   SET DR="41///"_(80\Y)

                   SET DIE="^ORD(101,"

                   SET DA=+ORGMENU

                   DO ^DIE

 +6        QUIT 

MNE       ; Edit mnemonic width for the protocol

 +1        NEW ORMNE,DIR,DIC,DIE,DR,DA

 +2        SET ORMNE=$PIECE($GET(^ORD(101,+ORGMENU,4)),"^",2)

 +3        SET DIR(0)="NAO^1:9"

           SET DIR("A")="Width for Mnemonics: "

           SET DIR("B")=$SELECT(ORMNE:ORMNE,1:5)

 +4        DO ^DIR

 +5        IF Y

               IF Y'=ORMNE

                   SET DR="42///"_Y

                   SET DIE="^ORD(101,"

                   SET DA=+ORGMENU

                   DO ^DIE

 +6        QUIT 

ADD       ; Add a new item to the menu

 +1        NEW DIC

 +2        SET DIC="^ORD(101,"

           SET DIC(0)="AEMQZ"

           SET DIC("A")="Select Item to be Added: "

 +3        FOR 

               DO ^DIC

               if Y'>0

                   QUIT 

               Begin DoDot:1

 +4                NEW D0,DD,DIC,DA,DIE,DR

 +5                if '$DATA(^ORD(101,+ORGMENU,10,0))

                       SET ^(0)="^101.01PA^^"

 +6                SET X=+Y

                   SET DA(1)=+ORGMENU

                   SET DIC="^ORD(101,"_DA(1)_",10,"

                   SET DIC(0)=""

 +7                DO FILE^DICN

                   IF +Y

                       SET DIE=DIC

                       SET DA=+Y

                       SET DR="3;2;6"

                       DO ^DIE

               End DoDot:1

 +8        QUIT 

EDIT      ; Edit an item on the menu

 +1        NEW ORGIDX,ORGLST,ORGFLG

 +2        SET ORGLST=$$LOOK^ORGUEM2("Select item(s) to be edited: ")

 +3        FOR ORGIDX=1:1:$LENGTH(ORGLST,",")

               IF +$PIECE(ORGLST,",",ORGIDX)

                   DO FLDS^ORGUEM2(+$PIECE(ORGLST,",",ORGIDX),.ORGFLG)

                   if ORGFLG

                       QUIT 

 +4        QUIT 

DEL       ; Delete an item from the menu

 +1        NEW ORGIDX,ORGLST,DA,DIK

 +2        SET ORGLST=$$LOOK^ORGUEM2("Select item(s) to be deleted: ")

 +3       ;delete item

           FOR ORGIDX=1:1:$LENGTH(ORGLST,",")

               Begin DoDot:1

 +4                SET DA=$PIECE(ORGLST,",",ORGIDX)

 +5                IF DA

                       SET DA(1)=+ORGMENU

                       SET DIK="^ORD(101,"_DA(1)_",10,"

                       DO ^DIK

               End DoDot:1

 +6        QUIT 

SHOW      ; Display the menu

 +1        NEW XQORM,X

 +2        WRITE !!,ORGMENU(0,0),?61,$$INHI^XQORM1,"HILITE",$$INLO^XQORM1,"=placeholder"

 +3        WRITE !

           FOR I=1:1:79

               WRITE "-"

 +4        DO SMENU^ORGUEM2

           if ORGMENU("TOG")="R"

               DO SET^ORGUEM1(+ORGMENU)

           DO EN^XQORM

 +5        IF ORGMENU("TOG")="F"

               Begin DoDot:1

 +6                WRITE !,$SELECT($DATA(XQORM("A")):XQORM("A"),1:"Select Item(s): ")

 +7                if $DATA(XQORM("B"))

                       WRITE XQORM("B")_"// "

               End DoDot:1

 +8        WRITE !

           FOR I=1:1:79

               WRITE "-"

 +9        QUIT 

TOG       ; Toggle menu display mode

 +1        IF ORGMENU("TOG")="R"

               SET ORGMENU("TOG")="F"

               WRITE !,"Menus will now be displayed as the user will see them."

 +2       IF '$TEST

               SET ORGMENU("TOG")="R"

               WRITE !,"Menus will now be displayed using actual sequence numbers and protocol names."

 +3        QUIT 

OPT       ; Edit optional menu parameters

 +1        NEW DIE,DR,DA

 +2        SET DIE="^ORD(101,"

           SET DR="[ORCL ADV MENU EDIT]"

           SET DA=+ORGMENU

           DO ^DIE

 +3        QUIT 

INQ       ; Inquire protocol file

 +1        NEW DIC,DA,DR,DIQ

 +2        SET DIC="^ORD(101,"

           SET DIC(0)="AEMQ"

           DO ^DIC

           if Y'>0

               QUIT 

 +3        WRITE !

           SET DA=+Y

           DO EN^DIQ

 +4        QUIT