150 lines
6.5 KiB
Mathematica
150 lines
6.5 KiB
Mathematica
ORCMENU ;SLC/MKB-Add Orders menus ; 08 May 2002 2:12 PM
|
|
;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,41,46,48,141**;Dec 17, 1997
|
|
;
|
|
EN ; -- main entry point
|
|
Q:'+$G(ORVP) ;I '+$G(ORVP) D EN^ORQPT Q:'+$G(ORVP)
|
|
S ORPTLK=$$LOCK^ORX2(+ORVP) I 'ORPTLK D Q ; lock pt chart
|
|
. W !!,$C(7),$P(ORPTLK,U,2) H 2 S VALMBCK=""
|
|
I $G(OREVENT),$G(^ORE(100.2,+OREVENT,1)) W !!,$C(7),$$NAME^OREVNTX(OREVENT)_" has been terminated!" H 2 S VALMBCK="" Q
|
|
D FULL^VALM1 S VALMBCK="R",ORACTION=0
|
|
W !!,"<"_$S($G(OREVENT):"Delayed ",1:"")_"Orders for "_$P($G(^DPT(+ORVP,0)),U)_">"
|
|
I $G(OREVENT) D ;show delay message
|
|
. W !!,"Now writing orders for "_$$NAME^OREVNTX(OREVENT)
|
|
. W !,"(To add orders for current release rather than delayed, quit the following"
|
|
. W !,"menu and return to viewing Active Orders via the Delayed Orders action.)"
|
|
. W !!,"Press <return> to continue ..." N X R X:DTIME
|
|
I '$G(ORL),'$G(OREVENT) S ORL=$$LOCATION^ORCMENU1 G:ORL["^" ENQ
|
|
S ORNP=$$PROVIDER^ORCMENU1 G:ORNP="^" ENQ
|
|
S ORENT="ALL^"_$G(ORL)_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+$G(^(5)),1:"")
|
|
S ORMENU=$$GET^XPAR(ORENT,"OR ADD ORDERS MENU") Q:ORMENU'>0
|
|
D EN^VALM("OR ADD ORDERS MENU"),REBLD:$D(ORTAB)
|
|
ENQ K ORPTLK,OREBUILD,ORMENU,ORENT,^TMP("ORMENU",$J),^TMP("ORECALL",$J),ZTSAVE
|
|
D:'$D(^TMP("ORNEW",$J)) UNLOCK^ORX2(+ORVP) ;unlock if no new orders
|
|
Q
|
|
;
|
|
REBLD ; -- Rebuild tab listings
|
|
I $G(ORTAB)="ORDERS" D TAB^ORCHART(ORTAB,1) Q
|
|
S:$D(^TMP("OR",$J,"ORDERS",0)) $P(^(0),U)="" ; force rebld of Orders tab
|
|
D:$G(ORTAB)="NEW" INIT^ORCMENU2 ; called from RV - rebuild list
|
|
Q
|
|
;
|
|
INIT ; -- init variables and list array
|
|
; Requires ORMENU = IFN of menu in Order Dialog file #101.41
|
|
; Optional OREVENT = Event pointer
|
|
;
|
|
N X,CW,MW,TITLE,ROWS,ROW,COL,Z,CNT,MNEM,TEXT,POS,ITEM,IFN,PROTOCL,FLAG,XQORM
|
|
S Z=$$MSG^ORXD(+ORMENU) I Z W !!,$P(Z,U,2) S VALMQUIT=1 H 2 Q ;disabled
|
|
S Z=$$LOCK^ORDD41(+ORMENU) I 'Z W !!,$P(Z,U,2) S VALMQUIT=1 H 2 Q
|
|
X:$D(^ORD(101.41,ORMENU,3)) ^(3) I $D(ORFORGET) D K ORFORGET
|
|
. I ORFORGET K ^TMP("ORECALL",$J,+ORFORGET) ;kill dlg
|
|
. E K ^TMP("ORECALL",$J) ;kill all
|
|
S CW=$P($G(^ORD(101.41,ORMENU,5)),U),MW=$P($G(^(5)),U,2),TITLE=$P(^(0),U,2)
|
|
S:'CW CW=80 S:'MW MW=5 S ROWS=$$ROWS(ORMENU) I 'ROWS S VALMQUIT=1 Q
|
|
S PROTOCL=$O(^ORD(101,"B","ORC ADD ITEM",0))_"^1"
|
|
S (POS,CNT)=0,XQORM=ORMENU_";ORD(101.41,"
|
|
IN1 F S POS=$O(^XUTL("XQORM",XQORM,POS)) Q:POS'>0 S ITEM=^(POS,0) D
|
|
. S ROW=$P(POS,"."),COL=$$COLUMN($P(POS,".",2),CW) Q:ROW'>0
|
|
. S IFN=$P(ITEM,U,2),TEXT=$P(ITEM,U,3),MNEM=$P(ITEM,U,4),FLAG=$P(ITEM,U,5)
|
|
. I FLAG="H" S Z=$E(TEXT,1,CW) D SETVIDEO(ROW,COL,$L(Z),IOUON,IOUOFF)
|
|
. I FLAG'="H" S Z=MNEM_$E(" ",1,MW-$L(MNEM))_$E(TEXT,1,CW-MW)
|
|
. S X(ROW,0)=$$SETSTR^VALM1(Z,$G(X(ROW,0)),COL,CW),CNT=CNT+1
|
|
. 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)
|
|
S X("KEY","ALL")=$O(^ORD(101,"B","ORC ADD ALL ITEMS",0))_"^1"
|
|
S X("KEY","CWAD")=$O(^ORD(101,"B","ORC CWAD DISPLAY",0))_"^1"
|
|
S X("KEY","PI")=$O(^ORD(101,"B","ORC PATIENT INQUIRY",0))_"^1"
|
|
INQ S X(0)=ROWS_U_CNT_U_CW_U_MW_U_$G(OREVENT),VALMCNT=ROWS
|
|
M ^TMP("ORMENU",$J,ORMENU)=X,^TMP("VALM VIDEO",$J,VALMEVL)=X("VIDEO")
|
|
I $L(TITLE),$$UP^XLFSTR(TITLE)'?1"ADD ".E S TITLE="Add "_TITLE
|
|
S VALM("TITLE")=$S($L(TITLE):TITLE,1:"Add New Orders")_$S($G(OREVENT):" for Delay",1:"")
|
|
Q
|
|
;
|
|
ROWS(MENU) ; -- Returns the number of rows in MENU
|
|
N MAX,I,R S MAX=0
|
|
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
|
|
Q MAX
|
|
;
|
|
COLUMN(NUM,WIDTH) ; -- Returns position of column NUM per WIDTH
|
|
N Y S:'$G(NUM) NUM=1 S:'$G(WIDTH) WIDTH=80
|
|
S Y=(NUM-1)*WIDTH+1
|
|
Q Y
|
|
;
|
|
SETVIDEO(LINE,COL,WIDTH,ON,OFF) ; -- set video attributes
|
|
S X("VIDEO",LINE,COL,WIDTH)=ON,X("VIDEO",LINE,COL+WIDTH,0)=OFF
|
|
Q
|
|
;
|
|
MSG() ; -- Message bar
|
|
Q "Enter the number of each item you wish to order."
|
|
;
|
|
HELP ; -- help code
|
|
N X D FULL^VALM1 S VALMBCK="R"
|
|
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."
|
|
W !!,"You may also enter PI to get additional patient information, or CWAD for",!,"access to this patient's crisis and warning notes."
|
|
W !!,"Press <return> to continue ..." R X:DTIME
|
|
Q
|
|
;
|
|
KILL ; -- Cleanup after Add New Orders option
|
|
I $D(^TMP("ORNEW",$J)) D EN^ORCMENU2,NOTIF^ORCMENU2 ; sign & release
|
|
K ORVP,ORSEX,ORPNM,ORSSN,ORL,ORDOB,ORAGE,ORPD,ORNP,ORSC,ORTS,ORWARD,ORATTEND,OREBUILD,^TMP("ORNEW",$J)
|
|
Q
|
|
;
|
|
EXIT ; -- exit code
|
|
X:$D(^ORD(101.41,ORMENU,4)) ^(4) ; exit action
|
|
K ^TMP("ORMENU",$J,ORMENU) D UNLOCK^ORDD41(+ORMENU)
|
|
Q
|
|
;
|
|
ALT ; -- XQORM("ALT") lookup
|
|
N XQORM,Y,ORX,ORY,ORI,IFN,POS,ITEM
|
|
S ORX=X D FULL^VALM1 S VALMBCK="R",X=ORX
|
|
S XQORM=+ORMENU_";ORD(101.41,",XQORM(0)="E"
|
|
D EN^XQORM Q:Y'>0 M ORY=Y S ORI=0
|
|
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)
|
|
Q
|
|
;
|
|
ALL ; -- process all menu items
|
|
N ORI,ITEM,X,IFN,POS S ORI=""
|
|
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)
|
|
Q
|
|
;
|
|
ITEM ; -- process menu item
|
|
N X,ITEM,IFN,POS S VALMBCK="R"
|
|
S X=$P(XQORNOD(0),U,3),ITEM=$G(^TMP("ORMENU",$J,ORMENU,"IDX",X))
|
|
S IFN=+$P(ITEM,U) Q:'IFN S POS=$P(ITEM,U,2)
|
|
ITM ; -- may enter here with IFN=Dlg, POS=position
|
|
N ROW,COL,CW,MW,TYPE,ORIT,PS S VALMBCK="R"
|
|
S ROW=$P(POS,"."),COL=$P(POS,".",2) S:'COL COL=1
|
|
S CW=$P(^TMP("ORMENU",$J,ORMENU,0),U,3),MW=$P(^(0),U,4),COL=COL-1*CW+1
|
|
D CNTRL^VALM10(ROW,COL+MW,CW-MW,IORVON,IORVOFF)
|
|
S TYPE=$P($G(^ORD(101.41,IFN,0)),U,4)
|
|
D MENU:TYPE="M" I TYPE'="M" S ORIT=IFN D FREEZE,EN^ORCDLG(IFN)
|
|
S:$G(DIROUT) XQORPOP=1 ; stop processing items
|
|
S PS=$P($G(^ORD(101.41,ORMENU,5)),U,3),VALMBCK=$S(PS:"R",1:"Q")
|
|
Q
|
|
;
|
|
MENU ; -- display sub-menu
|
|
N ORMENU S ORMENU=IFN
|
|
D EN^VALM("OR ADD ORDERS MENU")
|
|
Q
|
|
;
|
|
ORDER ; -- place order(s)
|
|
N ORDIALOG,ORIT,TITLE D FREEZE
|
|
S (ORIT,ORDIALOG)=IFN,TITLE=$P($G(^ORD(101.41,+ORDIALOG,0)),U,2)
|
|
W !!,?(36-($L(TITLE)\2)),"-- "_TITLE_" --"
|
|
D SET^ORCDLG:TYPE="O",ADD^ORCDLG:TYPE'="O" ; order set or single order?
|
|
K ^TMP("ORWORD",$J)
|
|
Q
|
|
;
|
|
SEARCH ; -- free text search of Orderable Items file
|
|
N ORDIALOG,DIC,OI
|
|
S OI=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0)),VALMBCK="R"
|
|
S DIC=101.43,DIC(0)="AEQM",DIC("A")="Select ORDER: "
|
|
D FULL^VALM1,^DIC Q:Y'>0
|
|
S ORDIALOG(OI,1)=Y ;,ORDIALOG=DG default dialog
|
|
D ADD^ORCDLG
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
FREEZE ; -- Freeze header, reset right margin
|
|
Q:'VALMCC N X S X=IOM X ^%ZOSF("RM")
|
|
S IOTM=VALM("TM"),IOBM=IOSL W IOSC,@IOSTBM,IORC
|
|
Q
|