73 lines
4.0 KiB
Mathematica
73 lines
4.0 KiB
Mathematica
ORCMEDT0 ;SLC/MKB-Dialog Utilities ;04:11 PM 12 Feb 1999
|
|
;;3.0;ORDER ENTRY/RESULTS REPORTING;**46,60,190,215**;Dec 17, 1997
|
|
DIALOG(TYPE) ; -- Get Dialog file entry
|
|
N X,Y,Z,D,DIC,DIE,DIK,DA,DR,DLAYGO,ORPKG,ORDLG,ORIT,OROI,I,IDX
|
|
S ORPKG="ORDER ENTRY/RESULTS REPORTING",DIC="^ORD(101.41,",DIC(0)="AEQLZ"
|
|
S DIC("S")="I $P(^(0),U,4)="""_TYPE_"""",DLAYGO=101.41
|
|
S DIC("A")="Select "_$S(TYPE="Q":"QUICK ORDER",TYPE="O":"ORDER SET",TYPE="A":"ACTION",1:"ORDER DIALOG")_" NAME: "
|
|
S DIC("DR")="4///"_TYPE_$S(TYPE="D":";7///^S X=ORPKG",1:"")
|
|
D0 S D="AB" D IX^DIC I Y'>0 S ORDLG="^" G DQ
|
|
S ORDLG=+Y,ORDG=$P(Y(0),U,5) G:'$P(Y,U,3) DQ ; not a new entry
|
|
I $O(^ORD(101.41,"AB",$P(Y,U,2),0))'=+Y W $C(7),!,"Another entry already exists by this name!",! D DEL(+Y) G D0
|
|
I TYPE="D" D G:ORDLG="^" DQ ;new dialog
|
|
. S DA=ORDLG,DR="5R",DIE=DIC,ORIT=$P(Y,U,2) D ^DIE
|
|
. S ORDG=+$P($G(^ORD(101.41,ORDLG,0)),U,5)
|
|
. I 'ORDG W $C(7),!,"Deleting <"_ORIT_"> ..." S DA=ORDLG,DIK=DIC D ^DIK S ORDLG="^" Q
|
|
. S ORIT=$$OI^ORCMEDT3(+ORDG) S:ORIT="^" ORDLG="^"
|
|
I TYPE="Q" D G DQ ;new quick order
|
|
. S DIC="^ORD(100.98,",DIC(0)="AEQM",DIC("S")="I $P(^(0),U,4)"
|
|
. S DIC("A")="TYPE OF QUICK ORDER: " D ^DIC
|
|
. I Y>0 S ORDG=+Y,$P(^ORD(101.41,ORDLG,0),U,5)=+Y Q
|
|
. W !,$P(^ORD(101.41,ORDLG,0),U)_" quick order dialog DELETED!",!
|
|
. S DA=ORDLG,DIK="^ORD(101.41,",ORDLG="^" D ^DIK
|
|
D1 I $$COPY^ORCMEDIT(TYPE) D ;copy an existing dialog?
|
|
. K DLAYGO,DIC("B") S DIC(0)="AEQZ",DIC("A")="Select "_$S(TYPE="Q":"QUICK ORDER",TYPE="O":"ORDER SET",1:"ORDER DIALOG")_" TO COPY: "
|
|
. D ^DIC Q:Y'>0 W !,"Copying ..."
|
|
. F I=2,6,8,9 S $P(^ORD(101.41,ORDLG,0),U,I)=$P(Y(0),U,I)
|
|
. S:TYPE'="D" $P(^ORD(101.41,ORDLG,0),U,5)=$P(Y(0),U,5) ;skip DG if Dlg
|
|
. S:$L($P(Y(0),U,2)) ^ORD(101.41,"C",$$UP^XLFSTR($P(Y(0),U,2)),ORDLG)="" ;disp text
|
|
. F I=2,3,3.1,4,5,6,7,9,10 I $D(^ORD(101.41,+Y,I)) M ^ORD(101.41,ORDLG,I)=^ORD(101.41,+Y,I)
|
|
. I $P(Y(0),U,7) S DA=ORDLG,DIE=DIC,DR="7///"_$P(Y(0),U,7) D ^DIE
|
|
. K DA S DA(1)=ORDLG,DIK="^ORD(101.41,"_ORDLG_",10,",DIK(1)="2^AD" D ENALL^DIK
|
|
D2 I TYPE="D",$G(ORIT) D ;stuff in default OI
|
|
. S DA=ORDLG,DR="2///"_$P(ORIT,U,2),DIE="^ORD(101.41," D ^DIE
|
|
. S OROI=$$PTR^ORCD("OR GTX ORDERABLE ITEM"),DA=$O(^ORD(101.41,ORDLG,10,"D",OROI,0)) I 'DA D Q:'DA ;create OI prompt
|
|
.. S X=+$O(^ORD(101.41,ORDLG,10,"B",0)),X=$S(X=0:1,1:X-.1) ;get Seq#
|
|
.. K DA,DIC S DIC="^ORD(101.41,"_ORDLG_",10,",DIC(0)="L",DA(1)=ORDLG
|
|
.. D ^DIC Q:Y'>0 S DA=+Y ;S DIC("P")=$P(^DD(101.41,10,0),U,2)
|
|
.. S Z=+$O(^ORD(101.41,ORDLG,10,"ATXT",0)),Z=$S(Z=0:1,1:Z-.1) ;TxtSeq#
|
|
.. S ^ORD(101.41,ORDLG,10,DA,0)=X_U_OROI_"^^Order: ^^1",^(2)=Z
|
|
.. S ^ORD(101.41,"AD",OROI,ORDLG,DA)="",^ORD(101.41,ORDLG,10,"B",X,DA)="",^ORD(101.41,ORDLG,10,"D",OROI,DA)="",^ORD(101.41,ORDLG,10,"ATXT",X,DA)=""
|
|
. S IDX="S."_$P($G(^ORD(100.98,+ORDG,0)),U,3)
|
|
. S $P(^ORD(101.41,ORDLG,10,DA,0),U,8)=1,$P(^(0),U,10)=IDX,^(3)="I 0 ;uneditable",^(7)="S Y="_+ORIT
|
|
DQ Q ORDLG
|
|
;
|
|
DEL(DA) ; -- delete bad entry in Order Dialog file
|
|
N DIK S DIK="^ORD(101.41," D:$G(DA) ^DIK
|
|
Q
|
|
;
|
|
SAVE ; -- Save ORDG, responses in ORDIALOG to dialog ORQDLG
|
|
N PROMPT,CNT,ITM,TYPE,INST,VALUE K ^ORD(101.41,ORQDLG,6)
|
|
S (PROMPT,CNT)=0 F S PROMPT=$O(ORDIALOG(PROMPT)) Q:PROMPT'>0 D
|
|
. S ITM=ORDIALOG(PROMPT),TYPE=$E(ORDIALOG(PROMPT,0))
|
|
. S INST=0 F S INST=$O(ORDIALOG(PROMPT,INST)) Q:INST'>0 D
|
|
. . S VALUE=$G(ORDIALOG(PROMPT,INST)),CNT=CNT+1
|
|
. . S ^ORD(101.41,ORQDLG,6,CNT,0)=+ITM_U_PROMPT_U_INST
|
|
. . S:TYPE'="W" ^ORD(101.41,ORQDLG,6,CNT,1)=VALUE
|
|
. . M:TYPE="W" ^ORD(101.41,ORQDLG,6,CNT,2)=@VALUE
|
|
. . S ^ORD(101.41,ORQDLG,6,"D",PROMPT,CNT)=""
|
|
S ^ORD(101.41,ORQDLG,6,0)="^101.416^"_CNT_U_CNT
|
|
S:$G(ORDG) $P(^ORD(101.41,ORQDLG,0),U,5)=+ORDG
|
|
Q
|
|
;
|
|
ITEM(Z) ; -- Select new item to add
|
|
N X,Y,DIC,ORDDF,ORERR,I
|
|
S DIC=101.41,DIC(0)="AEQM",DIC("A")="ITEM: "
|
|
I $G(Z) S Z=$P($G(^ORD(101.41,+Z,0)),U) S:$L(Z) DIC("B")=Z
|
|
S DIC("S")="I $P(^(0),U,4)'=""P"""
|
|
IT1 D ^DIC I Y'>0 S Y=$S($D(DUOUT)!$D(DTOUT):"^",1:"") Q Y
|
|
D RECURSV^ORCMEDT5(+Y,+ORMENU,.ORERR) I $D(ORERR) D G IT1
|
|
. W $C(7),!!,"An ancestor of this menu may not be added as an item!"
|
|
. W !,ORERR S I=0 F S I=$O(ORERR(I)) Q:I'>0 W !?18," =>"_ORERR(I)
|
|
Q +Y
|