source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCMEDT0.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.2 KB
RevLine 
[613]1ORCMEDT0 ;SLC/MKB-Dialog Utilities ;08/06/2007
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**46,60,190,215,243**;Dec 17, 1997;Build 242
3DIALOG(TYPE) ; -- Get Dialog file entry
4 N X,Y,Z,D,DIC,DIE,DIK,DA,DR,DLAYGO,ORPKG,ORDLG,ORIT,OROI,I,IDX
5 S ORPKG="ORDER ENTRY/RESULTS REPORTING",DIC="^ORD(101.41,",DIC(0)="AEQLZ"
6 S DIC("S")="I $P(^(0),U,4)="""_TYPE_"""",DLAYGO=101.41
7 S DIC("A")="Select "_$S(TYPE="Q":"QUICK ORDER",TYPE="O":"ORDER SET",TYPE="A":"ACTION",1:"ORDER DIALOG")_" NAME: "
8 S DIC("DR")="4///"_TYPE_$S(TYPE="D":";7///^S X=ORPKG",1:"")
9D0 S D="AB" D IX^DIC I Y'>0 S ORDLG="^" G DQ
10 S ORDLG=+Y,ORDG=$P(Y(0),U,5) G:'$P(Y,U,3) DQ ; not a new entry
11 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
12 I TYPE="D" D G:ORDLG="^" DQ ;new dialog
13 . S DA=ORDLG,DR="5R",DIE=DIC,ORIT=$P(Y,U,2) D ^DIE
14 . S ORDG=+$P($G(^ORD(101.41,ORDLG,0)),U,5)
15 . I 'ORDG W $C(7),!,"Deleting <"_ORIT_"> ..." S DA=ORDLG,DIK=DIC D ^DIK S ORDLG="^" Q
16 . S ORIT=$$OI^ORCMEDT3(+ORDG) S:ORIT="^" ORDLG="^"
17 I TYPE="Q" D G DQ ;new quick order
18 . S DIC="^ORD(100.98,",DIC(0)="AEQM",DIC("S")="I $P(^(0),U,4)"
19 . S DIC("A")="TYPE OF QUICK ORDER: " D ^DIC
20 . I Y>0 S ORDG=+Y,$P(^ORD(101.41,ORDLG,0),U,5)=+Y Q
21 . W !,$P(^ORD(101.41,ORDLG,0),U)_" quick order dialog DELETED!",!
22 . S DA=ORDLG,DIK="^ORD(101.41,",ORDLG="^" D ^DIK
23D1 I $$COPY^ORCMEDIT(TYPE) D ;copy an existing dialog?
24 . 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: "
25 . D ^DIC Q:Y'>0 W !,"Copying ..."
26 . F I=2,6,8,9 S $P(^ORD(101.41,ORDLG,0),U,I)=$P(Y(0),U,I)
27 . S:TYPE'="D" $P(^ORD(101.41,ORDLG,0),U,5)=$P(Y(0),U,5) ;skip DG if Dlg
28 . S:$L($P(Y(0),U,2)) ^ORD(101.41,"C",$$UP^XLFSTR($P(Y(0),U,2)),ORDLG)="" ;disp text
29 . 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)
30 . I $P(Y(0),U,7) S DA=ORDLG,DIE=DIC,DR="7///"_$P(Y(0),U,7) D ^DIE
31 . K DA S DA(1)=ORDLG,DIK="^ORD(101.41,"_ORDLG_",10,",DIK(1)="2^AD" D ENALL^DIK
32D2 I TYPE="D",$G(ORIT) D ;stuff in default OI
33 . S DA=ORDLG,DR="2///"_$P(ORIT,U,2),DIE="^ORD(101.41," D ^DIE
34 . 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
35 .. S X=+$O(^ORD(101.41,ORDLG,10,"B",0)),X=$S(X=0:1,1:X-.1) ;get Seq#
36 .. K DA,DIC S DIC="^ORD(101.41,"_ORDLG_",10,",DIC(0)="L",DA(1)=ORDLG
37 .. D ^DIC Q:Y'>0 S DA=+Y ;S DIC("P")=$P(^DD(101.41,10,0),U,2)
38 .. S Z=+$O(^ORD(101.41,ORDLG,10,"ATXT",0)),Z=$S(Z=0:1,1:Z-.1) ;TxtSeq#
39 .. S ^ORD(101.41,ORDLG,10,DA,0)=X_U_OROI_"^^Order: ^^1",^(2)=Z
40 .. 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)=""
41 . S IDX="S."_$P($G(^ORD(100.98,+ORDG,0)),U,3)
42 . 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
43DQ Q ORDLG
44 ;
45DEL(DA) ; -- delete bad entry in Order Dialog file
46 N DIK S DIK="^ORD(101.41," D:$G(DA) ^DIK
47 Q
48 ;
49SAVE ; -- Save ORDG, responses in ORDIALOG to dialog ORQDLG
50 N PROMPT,CNT,ITM,TYPE,INST,VALUE,INP,UD K ^ORD(101.41,ORQDLG,6)
51 S (PROMPT,CNT)=0 F S PROMPT=$O(ORDIALOG(PROMPT)) Q:PROMPT'>0 D
52 . S ITM=ORDIALOG(PROMPT),TYPE=$E(ORDIALOG(PROMPT,0))
53 . S INST=0 F S INST=$O(ORDIALOG(PROMPT,INST)) Q:INST'>0 D
54 . . S VALUE=$G(ORDIALOG(PROMPT,INST)),CNT=CNT+1
55 . . S ^ORD(101.41,ORQDLG,6,CNT,0)=+ITM_U_PROMPT_U_INST
56 . . S:TYPE'="W" ^ORD(101.41,ORQDLG,6,CNT,1)=VALUE
57 . . M:TYPE="W" ^ORD(101.41,ORQDLG,6,CNT,2)=@VALUE
58 . . S ^ORD(101.41,ORQDLG,6,"D",PROMPT,CNT)=""
59 S ^ORD(101.41,ORQDLG,6,0)="^101.416^"_CNT_U_CNT
60 S INP=+$O(^ORD(100.98,"B","INPATIENT MEDICATIONS",""))
61 S UD=+$O(^ORD(100.98,"B","UNIT DOSE MEDICATIONS",""))
62 I +$G(ORDG)>0,ORDG=INP,UD>0 S ORDG=UD
63 S:$G(ORDG) $P(^ORD(101.41,ORQDLG,0),U,5)=+ORDG
64 Q
65 ;
66ITEM(Z) ; -- Select new item to add
67 N X,Y,DIC,ORDDF,ORERR,I
68 S DIC=101.41,DIC(0)="AEQM",DIC("A")="ITEM: "
69 I $G(Z) S Z=$P($G(^ORD(101.41,+Z,0)),U) S:$L(Z) DIC("B")=Z
70 S DIC("S")="I $P(^(0),U,4)'=""P"""
71IT1 D ^DIC I Y'>0 S Y=$S($D(DUOUT)!$D(DTOUT):"^",1:"") Q Y
72 D RECURSV^ORCMEDT5(+Y,+ORMENU,.ORERR) I $D(ORERR) D G IT1
73 . W $C(7),!!,"An ancestor of this menu may not be added as an item!"
74 . W !,ORERR S I=0 F S I=$O(ORERR(I)) Q:I'>0 W !?18," =>"_ORERR(I)
75 Q +Y
Note: See TracBrowser for help on using the repository browser.