1 | ORDD41 ;slc/KCM,MKB-Build menus in XUTL (file 101.41) ;10:36 AM 11 Feb 1999
|
---|
2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,46,57**;Dec 17, 1997
|
---|
3 | SET(DLG) ; -- create dialog menu in ^XUTL("XQORM")
|
---|
4 | Q:$D(^ORD(101.41,DLG,0))[0 Q:$P(^(0),U,4)'="M"
|
---|
5 | N ITM,POS,COL,ROW,XQORM,TXT,PTR,X,R,C
|
---|
6 | S (POS,COL,ROW)=0,XQORM=DLG_";ORD(101.41,"
|
---|
7 | F S POS=$O(^ORD(101.41,DLG,10,"B",POS)) Q:POS="" S ITM=0 D
|
---|
8 | . F S ITM=$O(^ORD(101.41,DLG,10,"B",POS,ITM)) Q:ITM'>0 D
|
---|
9 | . . S X=$G(^ORD(101.41,DLG,10,ITM,0)),PTR=$P(X,U,2)
|
---|
10 | . . S TXT=$S($L($P(X,U,4)):$P(X,U,4),PTR:$P($G(^ORD(101.41,+PTR,0)),U,2),1:""),TXT=$TR(TXT,",=;-"," ") Q:'$L(TXT)
|
---|
11 | . . S ^XUTL("XQORM",XQORM,POS,0)=ITM_U_PTR_U_TXT_U_$P(X,U,3)_U_$TR($P(X,U,5),"120","OH")
|
---|
12 | . . S:$P(POS,".",2)>COL COL=$P(POS,".",2) Q:'PTR Q:$P(X,U,5)
|
---|
13 | . . S ^XUTL("XQORM",XQORM,"B",$$UP(TXT),POS)="" ;text
|
---|
14 | . . S:$L($P(X,U,3)) ^XUTL("XQORM",DLG_";ORD(101.41,","B",$$UP($P(X,U,3)),POS)=1 ;mnemonic
|
---|
15 | . S:$P(POS,".")>ROW ROW=$P(POS,".") ;hold last row
|
---|
16 | F R=1:1:ROW F C=1:1:COL S POS=R_"."_C S:'$D(^XUTL("XQORM",XQORM,POS,0)) ^(0)="^^ ^^O" ;blank
|
---|
17 | S X=$H,^XUTL("XQORM",DLG_";ORD(101.41,",0)=X,^("COL")=COL
|
---|
18 | S ^ORD(101.41,DLG,99)=X
|
---|
19 | Q
|
---|
20 | ;
|
---|
21 | KILL(DLG) ; -- Cleanup ^XUTL("XQORM")
|
---|
22 | K ^XUTL("XQORM",DLG_";ORD(101.41,")
|
---|
23 | Q
|
---|
24 | ;
|
---|
25 | UP(X) ;Convert X to upper case
|
---|
26 | Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
---|
27 | ;
|
---|
28 | REDO ; -- Rebuild menu in ^XUTL when changed
|
---|
29 | I $D(^ORD(101.41,DA,0)) S ^(99)=$H
|
---|
30 | Q
|
---|
31 | ;
|
---|
32 | REDOM ; -- Rebuild menu(s) in ^XUTL when DISPLAY TEXT changed
|
---|
33 | N X,MENU S X=$H
|
---|
34 | I $D(^ORD(101.41,DA,0)) S ^(99)=X
|
---|
35 | S MENU=0 F S MENU=$O(^ORD(101.41,"AD",DA,MENU)) Q:MENU'>0 I $D(^ORD(101.41,MENU,0)) S ^(99)=X
|
---|
36 | Q
|
---|
37 | ;
|
---|
38 | REDOX ; -- Rebuild menu in ^XUTL when ITEMS changed
|
---|
39 | I $D(^ORD(101.41,+$G(DA(1)),0)) S ^(99)=$H
|
---|
40 | Q
|
---|
41 | ;
|
---|
42 | TREE ; -- Ck menu tree to ensure new item is not an ancestor
|
---|
43 | ; Input Xform for Item field #2 of Items subfile #101.412
|
---|
44 | ; expecting DA, DA(1), X from FileMan
|
---|
45 | N ORDDA,ORDD S ORDDA=DA(1)
|
---|
46 | K:X=ORDDA X D TREE1
|
---|
47 | Q
|
---|
48 | TREE1 ; -- Look for X in ancestors
|
---|
49 | F ORDD=0:0 Q:'$D(X) S ORDD=$O(^ORD(101.41,"AD",ORDDA,ORDD)) Q:ORDD'>0 K:X=ORDD X Q:'$D(X) D TREE2
|
---|
50 | Q
|
---|
51 | TREE2 ; -- Back up another level
|
---|
52 | N ORDDA S ORDDA=ORDD N ORDD D TREE1
|
---|
53 | Q
|
---|
54 | ;
|
---|
55 | LIST(MENU) ; -- List items on MENU for ?-help in editor
|
---|
56 | N XQORM,TXT,POS,LCNT,QUIT,ITEM S (LCNT,QUIT)=0,TXT=""
|
---|
57 | S XQORM=+$G(MENU)_";"_$J Q:'$D(^XUTL("XQORM",XQORM))
|
---|
58 | F S TXT=$O(^XUTL("XQORM",XQORM,"B",TXT)) Q:TXT="" D Q:QUIT
|
---|
59 | . S POS=0 F S POS=$O(^XUTL("XQORM",XQORM,"B",TXT,POS)) Q:POS'>0 Q:^(POS) D Q:QUIT
|
---|
60 | . . S ITEM=$G(^XUTL("XQORM",XQORM,POS,0)),LCNT=LCNT+1
|
---|
61 | . . I LCNT>(IOSL-2) R !,"Press <return> to continue ...",X:DTIME S LCNT=0 I X["^" S QUIT=1 Q
|
---|
62 | . . W !?3,$P(ITEM,U,4),?10,$P(ITEM,U,3),$S($P(ITEM,U,2):" ["_$P($G(^ORD(101.41,+$P(ITEM,U,2),0)),U)_"]",1:"")
|
---|
63 | Q
|
---|
64 | ;
|
---|
65 | LOCK(MENU) ; -- Lock [and rebuild?] Order Dialog menu
|
---|
66 | N OK,XQORM S OK=1,XQORM=+MENU_";ORD(101.41,"
|
---|
67 | I $S('XQORM:1,'$D(^ORD(101.41,+MENU,0)):1,1:0) S OK="0^Invalid menu." G LKQ
|
---|
68 | I $D(^XUTL("XQORM",XQORM,0)),$P(^XUTL("XQORM",XQORM,0),U)'=$P($G(^ORD(101.41,+MENU,99)),U) D REBLD(+MENU)
|
---|
69 | I '$D(^XUTL("XQORM",XQORM,0)) D REBLD(+MENU,.OK) G:'OK LKQ
|
---|
70 | L +^XUTL("XQORM",XQORM,"XQORM PROTECT",$J):10 E S OK="0^Can't access menu at this time - try again later."
|
---|
71 | LKQ Q OK
|
---|
72 | ;
|
---|
73 | UNLOCK(MENU) ; -- Unlock Order Dialog menu
|
---|
74 | L -^XUTL("XQORM",+MENU_";ORD(101.41,","XQORM PROTECT",$J)
|
---|
75 | Q
|
---|
76 | ;
|
---|
77 | REBLD(MENU,RES) ; -- Lock, rebuild Order Dialog menu
|
---|
78 | N XQORM,DIE,DA,DR
|
---|
79 | S XQORM=+MENU_";ORD(101.41,",DIE="^ORD(101.41,",DA=+MENU,DR="99///"_$H
|
---|
80 | L +(^XUTL("XQORM",XQORM),^ORD(101.41,+MENU)):5 E S RES="0^Can't access menu at this time - try again later." Q
|
---|
81 | D ^DIE S RES=1
|
---|
82 | L -(^XUTL("XQORM",XQORM),^ORD(101.41,+MENU))
|
---|
83 | Q
|
---|