source: FOIAVistA/tag/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCMENU.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1ORCMENU ;SLC/MKB-Add Orders menus ; 08 May 2002 2:12 PM
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,41,46,48,141**;Dec 17, 1997
3 ;
4EN ; -- main entry point
5 Q:'+$G(ORVP) ;I '+$G(ORVP) D EN^ORQPT Q:'+$G(ORVP)
6 S ORPTLK=$$LOCK^ORX2(+ORVP) I 'ORPTLK D Q ; lock pt chart
7 . W !!,$C(7),$P(ORPTLK,U,2) H 2 S VALMBCK=""
8 I $G(OREVENT),$G(^ORE(100.2,+OREVENT,1)) W !!,$C(7),$$NAME^OREVNTX(OREVENT)_" has been terminated!" H 2 S VALMBCK="" Q
9 D FULL^VALM1 S VALMBCK="R",ORACTION=0
10 W !!,"<"_$S($G(OREVENT):"Delayed ",1:"")_"Orders for "_$P($G(^DPT(+ORVP,0)),U)_">"
11 I $G(OREVENT) D ;show delay message
12 . W !!,"Now writing orders for "_$$NAME^OREVNTX(OREVENT)
13 . W !,"(To add orders for current release rather than delayed, quit the following"
14 . W !,"menu and return to viewing Active Orders via the Delayed Orders action.)"
15 . W !!,"Press <return> to continue ..." N X R X:DTIME
16 I '$G(ORL),'$G(OREVENT) S ORL=$$LOCATION^ORCMENU1 G:ORL["^" ENQ
17 S ORNP=$$PROVIDER^ORCMENU1 G:ORNP="^" ENQ
18 S ORENT="ALL^"_$G(ORL)_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+$G(^(5)),1:"")
19 S ORMENU=$$GET^XPAR(ORENT,"OR ADD ORDERS MENU") Q:ORMENU'>0
20 D EN^VALM("OR ADD ORDERS MENU"),REBLD:$D(ORTAB)
21ENQ K ORPTLK,OREBUILD,ORMENU,ORENT,^TMP("ORMENU",$J),^TMP("ORECALL",$J),ZTSAVE
22 D:'$D(^TMP("ORNEW",$J)) UNLOCK^ORX2(+ORVP) ;unlock if no new orders
23 Q
24 ;
25REBLD ; -- Rebuild tab listings
26 I $G(ORTAB)="ORDERS" D TAB^ORCHART(ORTAB,1) Q
27 S:$D(^TMP("OR",$J,"ORDERS",0)) $P(^(0),U)="" ; force rebld of Orders tab
28 D:$G(ORTAB)="NEW" INIT^ORCMENU2 ; called from RV - rebuild list
29 Q
30 ;
31INIT ; -- init variables and list array
32 ; Requires ORMENU = IFN of menu in Order Dialog file #101.41
33 ; Optional OREVENT = Event pointer
34 ;
35 N X,CW,MW,TITLE,ROWS,ROW,COL,Z,CNT,MNEM,TEXT,POS,ITEM,IFN,PROTOCL,FLAG,XQORM
36 S Z=$$MSG^ORXD(+ORMENU) I Z W !!,$P(Z,U,2) S VALMQUIT=1 H 2 Q ;disabled
37 S Z=$$LOCK^ORDD41(+ORMENU) I 'Z W !!,$P(Z,U,2) S VALMQUIT=1 H 2 Q
38 X:$D(^ORD(101.41,ORMENU,3)) ^(3) I $D(ORFORGET) D K ORFORGET
39 . I ORFORGET K ^TMP("ORECALL",$J,+ORFORGET) ;kill dlg
40 . E K ^TMP("ORECALL",$J) ;kill all
41 S CW=$P($G(^ORD(101.41,ORMENU,5)),U),MW=$P($G(^(5)),U,2),TITLE=$P(^(0),U,2)
42 S:'CW CW=80 S:'MW MW=5 S ROWS=$$ROWS(ORMENU) I 'ROWS S VALMQUIT=1 Q
43 S PROTOCL=$O(^ORD(101,"B","ORC ADD ITEM",0))_"^1"
44 S (POS,CNT)=0,XQORM=ORMENU_";ORD(101.41,"
45IN1 F S POS=$O(^XUTL("XQORM",XQORM,POS)) Q:POS'>0 S ITEM=^(POS,0) D
46 . S ROW=$P(POS,"."),COL=$$COLUMN($P(POS,".",2),CW) Q:ROW'>0
47 . S IFN=$P(ITEM,U,2),TEXT=$P(ITEM,U,3),MNEM=$P(ITEM,U,4),FLAG=$P(ITEM,U,5)
48 . I FLAG="H" S Z=$E(TEXT,1,CW) D SETVIDEO(ROW,COL,$L(Z),IOUON,IOUOFF)
49 . I FLAG'="H" S Z=MNEM_$E(" ",1,MW-$L(MNEM))_$E(TEXT,1,CW-MW)
50 . S X(ROW,0)=$$SETSTR^VALM1(Z,$G(X(ROW,0)),COL,CW),CNT=CNT+1
51 . I $L(MNEM) S X("KEY",MNEM)=PROTOCL S:'$L(FLAG)&IFN X("IDX",MNEM)=IFN_U_POS D SETVIDEO(ROW,COL,MW,IOINHI,IOINORM)
52 S X("KEY","ALL")=$O(^ORD(101,"B","ORC ADD ALL ITEMS",0))_"^1"
53 S X("KEY","CWAD")=$O(^ORD(101,"B","ORC CWAD DISPLAY",0))_"^1"
54 S X("KEY","PI")=$O(^ORD(101,"B","ORC PATIENT INQUIRY",0))_"^1"
55INQ S X(0)=ROWS_U_CNT_U_CW_U_MW_U_$G(OREVENT),VALMCNT=ROWS
56 M ^TMP("ORMENU",$J,ORMENU)=X,^TMP("VALM VIDEO",$J,VALMEVL)=X("VIDEO")
57 I $L(TITLE),$$UP^XLFSTR(TITLE)'?1"ADD ".E S TITLE="Add "_TITLE
58 S VALM("TITLE")=$S($L(TITLE):TITLE,1:"Add New Orders")_$S($G(OREVENT):" for Delay",1:"")
59 Q
60 ;
61ROWS(MENU) ; -- Returns the number of rows in MENU
62 N MAX,I,R S MAX=0
63 S I=0 F S I=$O(^ORD(101.41,MENU,10,"B",I)) Q:I="" S R=$P(I,".") I R>MAX S MAX=R
64 Q MAX
65 ;
66COLUMN(NUM,WIDTH) ; -- Returns position of column NUM per WIDTH
67 N Y S:'$G(NUM) NUM=1 S:'$G(WIDTH) WIDTH=80
68 S Y=(NUM-1)*WIDTH+1
69 Q Y
70 ;
71SETVIDEO(LINE,COL,WIDTH,ON,OFF) ; -- set video attributes
72 S X("VIDEO",LINE,COL,WIDTH)=ON,X("VIDEO",LINE,COL+WIDTH,0)=OFF
73 Q
74 ;
75MSG() ; -- Message bar
76 Q "Enter the number of each item you wish to order."
77 ;
78HELP ; -- help code
79 N X D FULL^VALM1 S VALMBCK="R"
80 W !!,"Enter the items you wish to order for this patient, as a list or range of",!,"numbers. When you are done placing orders, enter Q to return to the",!,"patient's chart."
81 W !!,"You may also enter PI to get additional patient information, or CWAD for",!,"access to this patient's crisis and warning notes."
82 W !!,"Press <return> to continue ..." R X:DTIME
83 Q
84 ;
85KILL ; -- Cleanup after Add New Orders option
86 I $D(^TMP("ORNEW",$J)) D EN^ORCMENU2,NOTIF^ORCMENU2 ; sign & release
87 K ORVP,ORSEX,ORPNM,ORSSN,ORL,ORDOB,ORAGE,ORPD,ORNP,ORSC,ORTS,ORWARD,ORATTEND,OREBUILD,^TMP("ORNEW",$J)
88 Q
89 ;
90EXIT ; -- exit code
91 X:$D(^ORD(101.41,ORMENU,4)) ^(4) ; exit action
92 K ^TMP("ORMENU",$J,ORMENU) D UNLOCK^ORDD41(+ORMENU)
93 Q
94 ;
95ALT ; -- XQORM("ALT") lookup
96 N XQORM,Y,ORX,ORY,ORI,IFN,POS,ITEM
97 S ORX=X D FULL^VALM1 S VALMBCK="R",X=ORX
98 S XQORM=+ORMENU_";ORD(101.41,",XQORM(0)="E"
99 D EN^XQORM Q:Y'>0 M ORY=Y S ORI=0
100 F S ORI=$O(ORY(ORI)) Q:ORI'>0 S X=$P(ORY(ORI),U,4),IFN=$P(ORY(ORI),U,2),ITEM=$G(^ORD(101.41,+ORMENU,10,+$P(ORY(ORI),U),0)),POS=$P(ITEM,U) D ITM Q:$G(XQORPOP)
101 Q
102 ;
103ALL ; -- process all menu items
104 N ORI,ITEM,X,IFN,POS S ORI=""
105 F S ORI=$O(^TMP("ORMENU",$J,+ORMENU,"IDX",ORI)) Q:ORI="" S X=ORI,ITEM=$G(^(ORI)),IFN=+$P(ITEM,U),POS=$P(ITEM,U,2) D ITM Q:$G(XQORPOP)
106 Q
107 ;
108ITEM ; -- process menu item
109 N X,ITEM,IFN,POS S VALMBCK="R"
110 S X=$P(XQORNOD(0),U,3),ITEM=$G(^TMP("ORMENU",$J,ORMENU,"IDX",X))
111 S IFN=+$P(ITEM,U) Q:'IFN S POS=$P(ITEM,U,2)
112ITM ; -- may enter here with IFN=Dlg, POS=position
113 N ROW,COL,CW,MW,TYPE,ORIT,PS S VALMBCK="R"
114 S ROW=$P(POS,"."),COL=$P(POS,".",2) S:'COL COL=1
115 S CW=$P(^TMP("ORMENU",$J,ORMENU,0),U,3),MW=$P(^(0),U,4),COL=COL-1*CW+1
116 D CNTRL^VALM10(ROW,COL+MW,CW-MW,IORVON,IORVOFF)
117 S TYPE=$P($G(^ORD(101.41,IFN,0)),U,4)
118 D MENU:TYPE="M" I TYPE'="M" S ORIT=IFN D FREEZE,EN^ORCDLG(IFN)
119 S:$G(DIROUT) XQORPOP=1 ; stop processing items
120 S PS=$P($G(^ORD(101.41,ORMENU,5)),U,3),VALMBCK=$S(PS:"R",1:"Q")
121 Q
122 ;
123MENU ; -- display sub-menu
124 N ORMENU S ORMENU=IFN
125 D EN^VALM("OR ADD ORDERS MENU")
126 Q
127 ;
128ORDER ; -- place order(s)
129 N ORDIALOG,ORIT,TITLE D FREEZE
130 S (ORIT,ORDIALOG)=IFN,TITLE=$P($G(^ORD(101.41,+ORDIALOG,0)),U,2)
131 W !!,?(36-($L(TITLE)\2)),"-- "_TITLE_" --"
132 D SET^ORCDLG:TYPE="O",ADD^ORCDLG:TYPE'="O" ; order set or single order?
133 K ^TMP("ORWORD",$J)
134 Q
135 ;
136SEARCH ; -- free text search of Orderable Items file
137 N ORDIALOG,DIC,OI
138 S OI=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0)),VALMBCK="R"
139 S DIC=101.43,DIC(0)="AEQM",DIC("A")="Select ORDER: "
140 D FULL^VALM1,^DIC Q:Y'>0
141 S ORDIALOG(OI,1)=Y ;,ORDIALOG=DG default dialog
142 D ADD^ORCDLG
143 S VALMBCK="R"
144 Q
145 ;
146FREEZE ; -- Freeze header, reset right margin
147 Q:'VALMCC N X S X=IOM X ^%ZOSF("RM")
148 S IOTM=VALM("TM"),IOBM=IOSL W IOSC,@IOSTBM,IORC
149 Q
Note: See TracBrowser for help on using the repository browser.