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