ORCHART.m

ORCHART ;SLC/MKB/REV-OE/RR ; 11 March 2003 14:02

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,27,48,70,72,92,141,181**;Dec 17, 1997

EN ; -- main entry point

 K ^TMP("OR",$J) ;ensure fresh start

 D EN^ORQPT Q:+$G(ORVP)'>0

 D EN^VALM("OR CHART") G:'$G(OREXIT) EN

 K OREXIT

 Q

 ;

INIT ; -- init variables and list array

 S:'$D(ORTAB) ORTAB=$$UP^XLFSTR($$GET^XPAR("ALL","ORCH INITIAL TAB",1,"E"))

 S:ORTAB="DCSUMM" ORTAB="SUMMRIES" S:'$L(ORTAB) ORTAB="COVER"

 S ORACTION=0 D TAB(ORTAB)

 Q

 ;

PHDR ; -- protocol header code

 N ORM,ORI,ORS,ORSYN K ORNMBR,OREBUILD

 S:$G(ORTAB)'="LABS" VALMSG=$$MSG D SHOW^VALM

 S:XQORM("B")="Quit" XQORM("B")=$S('$G(DGPMT):"Chart Contents",1:"Close Patient Chart")

 S:$G(^TMP("OR",$J,"CURRENT","#")) XQORM("#")=^("#")

 S ORM=$S(ORTAB="CONSULTS":+$O(^ORD(101,"B","ORC CONSULT SERVICE MENU",0)),1:+$G(XQORM("#"))),ORI=0 ;set XQORM("KEY",<synonym>)

 F  S ORI=$O(^ORD(101,ORM,10,"B",ORI)) Q:ORI'>0  I $D(^ORD(101,+ORI,2)) D

 . S ORS=0 F  S ORS=$O(^ORD(101,+ORI,2,ORS)) Q:ORS'>0  S ORSYN=$G(^(ORS,0)) S:$L(ORSYN) XQORM("KEY",ORSYN)=+ORI_"^1"

 S XQORM("KEY","EX")=$O(^ORD(101,"B","ORC EXIT",0))_"^1"

 S XQORM("KEY","NEXT")=$O(^ORD(101,"B","ORC NEXT SCREEN",0))_"^1"

 S XQORM("KEY","PL")=$O(^ORD(101,"B","ORC PRINT LIST",0))_"^1"

 Q

 ;

HDR ; -- header code

 ;    Expects ORPNM, ORSSN, ORL, ORDOB, ORAGE [, ORPD]

 ;    N DFN S DFN=+ORVP D SLCT1^ORQPT if any are missing ??

 N ORX,ORX1,ORX2,ORX3,ORCWAD,L,SP K VALMHDR

 S ORX1=$P($G(^DPT(+ORVP,0)),U,3),ORX3=$$FMTE^XLFDT(ORX1,2)_"("_ORAGE_")"

 S ORX2="" I +$G(ORL) D  S:$L($G(ORL(1))) ORX2=ORX2_"/"_ORL(1)

 . S L=$G(^SC(+ORL,0)),ORX2=$P(L,U,2)

 . S:'$L(ORX2) ORX2=$E($P(L,U),1,4)

 S L=80-$L(ORPNM)-$L(ORSSN)-$L(ORX2)-$L(ORX3),SP=$$REPEAT^XLFSTR(" ",L\3)

 S ORX1=ORPNM_SP_ORSSN_SP_ORX2,VALMHDR(1)=ORX1_$J(ORX3,80-$L(ORX1))

 S ORX1=$S(ORATTEND:"Attend: "_$$LNAMEF^ORCHTAB(ORATTEND),1:"")

 S ORX2="PrimCare: "_$$LNAMEF^ORCHTAB(+$$OUTPTPR^SDUTL3(+ORVP))

 S ORX3="PCTeam: "_$P($$OUTPTTM^SDUTL3(+ORVP),U,2)

 S ORX=$S($L(ORX1):$$LJ^XLFSTR(ORX1,20),1:"")_ORX2,VALMHDR(2)=$$LJ^XLFSTR(ORX,42)_ORX3

 S ORCWAD=$$CWAD^ORQPT2(+ORVP) S:ORCWAD]"" ORCWAD="<"_ORCWAD_">"

 S ORX=$S($G(ORTAB)="COVER":"",$G(ORTAB)="REPORTS":"",1:$$VIEW),VALMHDR(3)=ORX_$J(ORCWAD,80-$L(ORX))

 Q

 ;

MSG() ; -- LMgr message bar

 Q "Enter the numbers of the items you wish to act on."

 ;

HELP ; -- help code

 N X,DX,DY D FULL^VALM1

 W !!,"Enter the display numbers of the items you wish to change or act on; a menu of",!,"available actions will then be presented for selection."

 W !!,"To see a different 'page' of the chart, enter CC; if you'd like another view of",!,"the current page, by date range for example, enter CV.  You may add new orders"

 W !,"for this patient from any page in the chart by entering AD and review them",!,"using RV.  Enter ?? to see a list of actions available for navigating the list."

 W:ORTAB="PROBLEMS" !!,"* = Acute problem",!,"$ = Unverified problem",!,"# = Problem references inactive code"

 W:(ORTAB="SUMMRIES")!(ORTAB="NOTES") !!,"+ = Addenda attached"

 W:(ORTAB="ORDERS")!(ORTAB="MEDS") !!,"* = Order has been updated by service"

 W:ORTAB="ORDERS" !,"+ = Sub-orders exist"

 W !!,"Press <return> to continue ..." R X:DTIME

 S VALMBCK="R" S:$G(ORTAB)'="LABS" VALMSG=$$MSG

 S (DX,DY)=0 X ^%ZOSF("XY")

 Q

 ;

ITEMHELP ; -- help code for action menus

 N X

 W !!,"Enter the action you wish to take on the items selected and highlighted",!,"above; each item will be processed in order, one at a time."

 W !!,"Press <return> to continue ..." R X:DTIME

 S X="?" D DISP^XQORM1 W !

 Q

 ;

EXIT ; -- exit code

 I $G(ORVP),$$MORE^ORCMENU2 D  ;unsig orders

 . ;I '$D(^TMP("ORNEW",$J)),'$D(^XUSEC("ORES",DUZ)) Q  ;msg like 2.5??

 . W !!,"You have new or unsigned orders for this patient!" H 1

 . S ORRV=1 D EN1^ORCMENU2,NOTIF^ORCMENU2 ;sign, notif if not all signed

 D UNLOCK^ORX2(+ORVP) K ^TMP("OR",$J),^TMP("ORNEW",$J),^TMP("LRRR",$J)

 K VALMCNT,VALMHDR,VALMBG,ORQUIT,ORVP,ORSEX,ORTAB,ORPNM,ORSSN,ORL,ORDOB,ORAGE,ORPD,ORNP,ORSC,ORTS,ORWARD,ORATTEND,ORNMBR,ORACTION,OREBUILD,OREBLD,ORRV,OREVENT

 Q

 ;

TAB(NEWTAB,REBUILD) ; -- switch focus to new chart tab from ORTAB

 S VALMBCK="",VALMBG=$S($G(ORTAB)'=NEWTAB:1,'$G(VALMBG):1,1:VALMBG)

 S ORTAB=NEWTAB I '$G(^TMP("OR",$J,ORTAB,0))!($G(REBUILD)) D

 . W !,"Searching the patient's chart ..."

 . D FULL^VALM1,EN^ORCHTAB ; [re]build list

 D CLEAN^VALM10 M ^TMP("OR",$J,"CURRENT")=^TMP("OR",$J,ORTAB)

 M ^TMP("VALM VIDEO",$J,VALMEVL)=^TMP("OR",$J,"CURRENT","VIDEO")

 I $D(^TMP("OR",$J,"CURRENT","CAPTION")) D

 . N FLD,LBL S FLD=""

 . F  S FLD=$O(^TMP("OR",$J,"CURRENT","CAPTION",FLD)) Q:FLD=""  S LBL=$G(^(FLD)) D CHGCAP^VALM(FLD,LBL)

 S VALM("TITLE")=$G(^TMP("OR",$J,"CURRENT","TITLE")),VALM("RM")=^("RM")

 S:$D(^TMP("OR",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")

 S VALMCNT=+$G(^TMP("OR",$J,"CURRENT",0)),VALMLFT=$P(VALMDDF("DATA"),U,2)

 D HDR S VALMBCK="R" ; reset VALMHDR nodes

 Q

 ;

NEWPAT ; -- Select new patient

 I $$MORE^ORCMENU2 D  ;unsigned orders

 . ;I '$D(^TMP("ORNEW",$J)),'$D(^XUSEC("ORES",DUZ)) Q

 . W !!,"You have new or unsigned orders for this patient!" H 1

 . S ORRV=1 D EN1^ORCMENU2,NOTIF^ORCMENU2 ;sign, notif if not all signed

 N TAB,OLD,T,ORT,CTXT K ORRV S OLD=+ORVP,TAB=ORTAB

 D EN^ORQPT I OLD=+ORVP S VALMBCK="R" D:$G(OREBUILD) REBLD^ORCMENU K OREBUILD Q  ; no change

 S T="" F  S T=$O(^TMP("OR",$J,T)) Q:T=""  D

 . I T="MEDS" K ^TMP("OR",$J,T) Q

 . S CTXT=$P($G(^TMP("OR",$J,T,0)),U,3) S:$L(CTXT) ORT(T,0)="^^"_$S(T="NOTES"&($P(CTXT,";",3)=1):"",1:CTXT)_U_$P(^(0),U,4) ; save tab contexts

 D UNLOCK^ORX2(+ORVP) K ^TMP("OR",$J),^TMP("ORNEW",$J),^TMP("LRRR",$J)

 K VALMHDR,ORTAB,ORNEW,OREBUILD,OREBLD

 M ^TMP("OR",$J)=ORT D TAB(TAB) S VALMBCK="R"

 Q

 ;

ORDERS(ACTION) ; -- Return order numbers to act on, if action chosen first

 N X,Y,DIR,MAX S:'$L($G(ACTION)) ACTION="act on"

 S MAX=+$P($G(^TMP("OR",$J,ORTAB,0)),U,2) Q:MAX'>0 "^"

 S DIR(0)="LAO^1:"_MAX,DIR("A")="Select item(s): " S:MAX=1 DIR("B")=1

 S DIR("?")="Enter the items you wish to "_ACTION_", as a range or list of numbers"

 D ^DIR S:$D(DTOUT)!(Y="") Y="^"

 Q Y

 ;

ALL ; -- Return all items on ORTAB

 N X,Y,DIR,MAX

 S MAX=+$P($G(^TMP("OR",$J,ORTAB,0)),U,2) Q:MAX'>0 ""

 S DIR(0)="L^1:"_MAX,DIR("V")="",X="1-"_MAX D ^DIR

 Q Y

 ;

SELECT(NMBR) ; -- rev video on selected items

 N ORI,ORJ,NUM,ROW,ROWS,VALID S VALID=0

 F ORI=1:1:$L(NMBR,",") S NUM=$P(NMBR,",",ORI) I NUM D

 . I '$L($P($G(@VALMAR@("IDX",NUM)),U)) W !,NUM_" is not a valid selection." H 2 Q

 . S VALID=1

 . S ROW=$P(@VALMAR@("IDX",NUM),U,2),ROWS=$P(^(NUM),U,3)

 . F ORJ=ROW:1:(ROW+ROWS-1) I ORJ'<VALMBG,ORJ'>(VALMBG+VALM("LINES")-1) D

 . . K ^TMP("VALM VIDEO",$J,VALMEVL,ORJ)

 . . D CNTRL^VALM10(ORJ,1,80,IORVON,IORVOFF)

 . . D WRITE^VALM10(ORJ)

 I 'VALID S XQORQUIT=1

 Q

 ;

DESELECT(NMBR) ; -- norm video on selected items

 N ORI,ORJ,NUM,IFN,ROW,ROWS,ON,OFF,I,IDX

 F ORI=1:1:$L(NMBR,",") S NUM=$P(NMBR,",",ORI) I NUM D

 . S IDX=$G(@VALMAR@("IDX",NUM)) Q:'$L(IDX)  ;invalid NUM

 . S IFN=$P(IDX,U),ROW=$P(IDX,U,2),ROWS=$P(IDX,U,3)

 . F ORJ=ROW:1:(ROW+ROWS-1) I ORJ'<VALMBG,ORJ'>(VALMBG+VALM("LINES")-1) D

 . . K ^TMP("VALM VIDEO",$J,VALMEVL,ORJ) Q:'$L(IFN)  ;deleted

 . . S ON=IOINHI,OFF=IOINORM

 . . I ORTAB="ORDERS",$G(^OR(100,+IFN,8,+$P(IFN,";",2),3)) S ON=IORVON,OFF=IORVOFF ; flagged

 . . D CNTRL^VALM10(ORJ,1,5,ON,OFF)

 . . I ORTAB="ORDERS" S I=$F(^TMP("OR",$J,ORTAB,ORJ,0),"*UNSIGNED*") I I D CNTRL^VALM10(ORJ,I-10,10,IOINHI,IOINORM)

 . . I ORTAB="XRAYS" S I=$F(^TMP("OR",$J,ORTAB,ORJ,0),"*ABNORMAL*") I I D CNTRL^VALM10(ORJ,I-10,10,IOINHI,IOINORM)

 . . I ORTAB="LABS" D CNTRL^VALM10(ORJ,24,2,IOINHI,IOINORM)

 . . D:VALMBCK="" WRITE^VALM10(ORJ)

 Q

 ;

CHANGE ; -- Change view of current list

 G EN^ORCHANGE

 Q

 ;

REV(ORVP) ; -- Review orders for patient

 Q:'$G(ORVP)  Q:$D(ZTQUEUED)  Q:$G(DGQUIET)  ;silent

 I $D(SDAMEVT) Q:$S(SDAMEVT=1:0,1:1)  ;continue if new appt

 Q:'$$GET^XPAR("ALL","ORPF REVIEW ON PATIENT MVMT")

 Q:'$$ACCESS^ORCHTAB  ;CPRS not in user's option menu tree

 N X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,DFN ;protect DFN

 S DFN=+ORVP,ORVP=DFN_";DPT("  Q:'$D(^OR(100,"AC",ORVP))  ; no orders

 S DIR(0)="YA",DIR("A")="Review active orders? ",DIR("B")="YES"

 S DIR("?")="Answer YES to review this patient's active orders"

 D ^DIR Q:Y'>0  K DIR

 D SLCT1^ORQPT Q:'$G(ORVP)

 S ORTAB="ORDERS" D EN^VALM("OR CHART")

 Q

 ;

VIEW() ; -- return line 3 of header w/current view of tab 

 N BEGIN,END,ITEMS,STS,TEXT,X

 I $G(ORTAB)']"" Q ""

 S X=$P($G(^TMP("OR",$J,ORTAB,0)),U,3),TEXT=""

 S BEGIN=$P(X,";"),END=$P(X,";",2),STS=$P(X,";",3),ITEMS=$P(X,";",5)

 I ORTAB="NOTES",(STS'=5) S TEXT=$S(ITEMS:"up to "_ITEMS,1:"all")_$S(STS=1:" notes",STS=2:" unsigned notes",STS=3:" uncosigned notes",STS=4:" signed notes by author",1:"")

 E  D

 . S:$L(BEGIN)!$L(END) TEXT=$$FDATE^VALM1($$DT^ORCHTAB1(BEGIN))_" thru "_$$FDATE^VALM1($$DT^ORCHTAB1(END))

 . I ORTAB="XRAYS",ITEMS>0 S TEXT=$S($L(TEXT):TEXT_", ",1:"")_"limit "_ITEMS

 S:$L(TEXT) TEXT="Current View: "_TEXT,TEXT=$J(TEXT,40+($L(TEXT)\2))

 Q TEXT

ORCHART   ;SLC/MKB/REV-OE/RR ; 11 March 2003 14:02

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,27,48,70,72,92,141,181**;Dec 17, 1997

EN        ; -- main entry point

 +1       ;ensure fresh start

           KILL ^TMP("OR",$JOB)

 +2        DO EN^ORQPT

           IF +$GET(ORVP)'>0

               QUIT 

 +3        DO EN^VALM("OR CHART")

           IF '$GET(OREXIT)

               GOTO EN

 +4        KILL OREXIT

 +5        QUIT 

 +6       ;

INIT      ; -- init variables and list array

 +1        IF '$DATA(ORTAB)

               SET ORTAB=$$UP^XLFSTR($$GET^XPAR("ALL","ORCH INITIAL TAB",1,"E"))

 +2        IF ORTAB="DCSUMM"

               SET ORTAB="SUMMRIES"

           IF '$LENGTH(ORTAB)

               SET ORTAB="COVER"

 +3        SET ORACTION=0

           DO TAB(ORTAB)

 +4        QUIT 

 +5       ;

PHDR      ; -- protocol header code

 +1        NEW ORM,ORI,ORS,ORSYN

           KILL ORNMBR,OREBUILD

 +2        IF $GET(ORTAB)'="LABS"

               SET VALMSG=$$MSG

           DO SHOW^VALM

 +3        IF XQORM("B")="Quit"

               SET XQORM("B")=$SELECT('$GET(DGPMT):"Chart Contents",1:"Close Patient Chart")

 +4        IF $GET(^TMP("OR",$JOB,"CURRENT","#"))

               SET XQORM("#")=^("#")

 +5       ;set XQORM("KEY",<synonym>)

           SET ORM=$SELECT(ORTAB="CONSULTS":+$ORDER(^ORD(101,"B","ORC CONSULT SERVICE MENU",0)),1:+$GET(XQORM("#")))

           SET ORI=0

 +6        FOR 

               SET ORI=$ORDER(^ORD(101,ORM,10,"B",ORI))

               IF ORI'>0

                   QUIT 

               IF $DATA(^ORD(101,+ORI,2))

                   Begin DoDot:1

 +7                    SET ORS=0

                       FOR 

                           SET ORS=$ORDER(^ORD(101,+ORI,2,ORS))

                           IF ORS'>0

                               QUIT 

                           SET ORSYN=$GET(^(ORS,0))

                           IF $LENGTH(ORSYN)

                               SET XQORM("KEY",ORSYN)=+ORI_"^1"

                   End DoDot:1

 +8        SET XQORM("KEY","EX")=$ORDER(^ORD(101,"B","ORC EXIT",0))_"^1"

 +9        SET XQORM("KEY","NEXT")=$ORDER(^ORD(101,"B","ORC NEXT SCREEN",0))_"^1"

 +10       SET XQORM("KEY","PL")=$ORDER(^ORD(101,"B","ORC PRINT LIST",0))_"^1"

 +11       QUIT 

 +12      ;

HDR       ; -- header code

 +1       ;    Expects ORPNM, ORSSN, ORL, ORDOB, ORAGE [, ORPD]

 +2       ;    N DFN S DFN=+ORVP D SLCT1^ORQPT if any are missing ??

 +3        NEW ORX,ORX1,ORX2,ORX3,ORCWAD,L,SP

           KILL VALMHDR

 +4        SET ORX1=$PIECE($GET(^DPT(+ORVP,0)),U,3)

           SET ORX3=$$FMTE^XLFDT(ORX1,2)_"("_ORAGE_")"

 +5        SET ORX2=""

           IF +$GET(ORL)

               Begin DoDot:1

 +6                SET L=$GET(^SC(+ORL,0))

                   SET ORX2=$PIECE(L,U,2)

 +7                IF '$LENGTH(ORX2)

                       SET ORX2=$EXTRACT($PIECE(L,U),1,4)

               End DoDot:1

               IF $LENGTH($GET(ORL(1)))

                   SET ORX2=ORX2_"/"_ORL(1)

 +8        SET L=80-$LENGTH(ORPNM)-$LENGTH(ORSSN)-$LENGTH(ORX2)-$LENGTH(ORX3)

           SET SP=$$REPEAT^XLFSTR(" ",L\3)

 +9        SET ORX1=ORPNM_SP_ORSSN_SP_ORX2

           SET VALMHDR(1)=ORX1_$JUSTIFY(ORX3,80-$LENGTH(ORX1))

 +10       SET ORX1=$SELECT(ORATTEND:"Attend: "_$$LNAMEF^ORCHTAB(ORATTEND),1:"")

 +11       SET ORX2="PrimCare: "_$$LNAMEF^ORCHTAB(+$$OUTPTPR^SDUTL3(+ORVP))

 +12       SET ORX3="PCTeam: "_$PIECE($$OUTPTTM^SDUTL3(+ORVP),U,2)

 +13       SET ORX=$SELECT($LENGTH(ORX1):$$LJ^XLFSTR(ORX1,20),1:"")_ORX2

           SET VALMHDR(2)=$$LJ^XLFSTR(ORX,42)_ORX3

 +14       SET ORCWAD=$$CWAD^ORQPT2(+ORVP)

           IF ORCWAD]""

               SET ORCWAD="<"_ORCWAD_">"

 +15       SET ORX=$SELECT($GET(ORTAB)="COVER":"",$GET(ORTAB)="REPORTS":"",1:$$VIEW)

           SET VALMHDR(3)=ORX_$JUSTIFY(ORCWAD,80-$LENGTH(ORX))

 +16       QUIT 

 +17      ;

MSG()     ; -- LMgr message bar

 +1        QUIT "Enter the numbers of the items you wish to act on."

 +2       ;

HELP      ; -- help code

 +1        NEW X,DX,DY

           DO FULL^VALM1

 +2        WRITE !!,"Enter the display numbers of the items you wish to change or act on; a menu of",!,"available actions will then be presented for selection."

 +3        WRITE !!,"To see a different 'page' of the chart, enter CC; if you'd like another view of",!,"the current page, by date range for example, enter CV.  You may add new orders"

 +4        WRITE !,"for this patient from any page in the chart by entering AD and review them",!,"using RV.  Enter ?? to see a list of actions available for navigating the list."

 +5        IF ORTAB="PROBLEMS"

               WRITE !!,"* = Acute problem",!,"$ = Unverified problem",!,"# = Problem references inactive code"

 +6        IF (ORTAB="SUMMRIES")!(ORTAB="NOTES")

               WRITE !!,"+ = Addenda attached"

 +7        IF (ORTAB="ORDERS")!(ORTAB="MEDS")

               WRITE !!,"* = Order has been updated by service"

 +8        IF ORTAB="ORDERS"

               WRITE !,"+ = Sub-orders exist"

 +9        WRITE !!,"Press <return> to continue ..."

           READ X:DTIME

 +10       SET VALMBCK="R"

           IF $GET(ORTAB)'="LABS"

               SET VALMSG=$$MSG

 +11       SET (DX,DY)=0

           XECUTE ^%ZOSF("XY")

 +12       QUIT 

 +13      ;

ITEMHELP  ; -- help code for action menus

 +1        NEW X

 +2        WRITE !!,"Enter the action you wish to take on the items selected and highlighted",!,"above; each item will be processed in order, one at a time."

 +3        WRITE !!,"Press <return> to continue ..."

           READ X:DTIME

 +4        SET X="?"

           DO DISP^XQORM1

           WRITE !

 +5        QUIT 

 +6       ;

EXIT      ; -- exit code

 +1       ;unsig orders

           IF $GET(ORVP)

               IF $$MORE^ORCMENU2

                   Begin DoDot:1

 +2       ;I '$D(^TMP("ORNEW",$J)),'$D(^XUSEC("ORES",DUZ)) Q  ;msg like 2.5??

 +3                    WRITE !!,"You have new or unsigned orders for this patient!"

                       HANG 1

 +4       ;sign, notif if not all signed

                       SET ORRV=1

                       DO EN1^ORCMENU2

                       DO NOTIF^ORCMENU2

                   End DoDot:1

 +5        DO UNLOCK^ORX2(+ORVP)

           KILL ^TMP("OR",$JOB),^TMP("ORNEW",$JOB),^TMP("LRRR",$JOB)

 +6        KILL VALMCNT,VALMHDR,VALMBG,ORQUIT,ORVP,ORSEX,ORTAB,ORPNM,ORSSN,ORL,ORDOB,ORAGE,ORPD,ORNP,ORSC,ORTS,ORWARD,ORATTEND,ORNMBR,ORACTION,OREBUILD,OREBLD,ORRV,OREVENT

 +7        QUIT 

 +8       ;

TAB(NEWTAB,REBUILD) ; -- switch focus to new chart tab from ORTAB

 +1        SET VALMBCK=""

           SET VALMBG=$SELECT($GET(ORTAB)'=NEWTAB:1,'$GET(VALMBG):1,1:VALMBG)

 +2        SET ORTAB=NEWTAB

           IF '$GET(^TMP("OR",$JOB,ORTAB,0))!($GET(REBUILD))

               Begin DoDot:1

 +3                WRITE !,"Searching the patient's chart ..."

 +4       ; [re]build list

                   DO FULL^VALM1

                   DO EN^ORCHTAB

               End DoDot:1

 +5        DO CLEAN^VALM10

           MERGE ^TMP("OR",$JOB,"CURRENT")=^TMP("OR",$JOB,ORTAB)

 +6        MERGE ^TMP("VALM VIDEO",$JOB,VALMEVL)=^TMP("OR",$JOB,"CURRENT","VIDEO")

 +7        IF $DATA(^TMP("OR",$JOB,"CURRENT","CAPTION"))

               Begin DoDot:1

 +8                NEW FLD,LBL

                   SET FLD=""

 +9                FOR 

                       SET FLD=$ORDER(^TMP("OR",$JOB,"CURRENT","CAPTION",FLD))

                       IF FLD=""

                           QUIT 

                       SET LBL=$GET(^(FLD))

                       DO CHGCAP^VALM(FLD,LBL)

               End DoDot:1

 +10       SET VALM("TITLE")=$GET(^TMP("OR",$JOB,"CURRENT","TITLE"))

           SET VALM("RM")=^("RM")

 +11       IF $DATA(^TMP("OR",$JOB,"CURRENT","MENU"))

               SET XQORM("HIJACK")=^("MENU")

 +12       SET VALMCNT=+$GET(^TMP("OR",$JOB,"CURRENT",0))

           SET VALMLFT=$PIECE(VALMDDF("DATA"),U,2)

 +13      ; reset VALMHDR nodes

           DO HDR

           SET VALMBCK="R"

 +14       QUIT 

 +15      ;

NEWPAT    ; -- Select new patient

 +1       ;unsigned orders

           IF $$MORE^ORCMENU2

               Begin DoDot:1

 +2       ;I '$D(^TMP("ORNEW",$J)),'$D(^XUSEC("ORES",DUZ)) Q

 +3                WRITE !!,"You have new or unsigned orders for this patient!"

                   HANG 1

 +4       ;sign, notif if not all signed

                   SET ORRV=1

                   DO EN1^ORCMENU2

                   DO NOTIF^ORCMENU2

               End DoDot:1

 +5        NEW TAB,OLD,T,ORT,CTXT

           KILL ORRV

           SET OLD=+ORVP

           SET TAB=ORTAB

 +6       ; no change

           DO EN^ORQPT

           IF OLD=+ORVP

               SET VALMBCK="R"

               IF $GET(OREBUILD)

                   DO REBLD^ORCMENU

               KILL OREBUILD

               QUIT 

 +7        SET T=""

           FOR 

               SET T=$ORDER(^TMP("OR",$JOB,T))

               IF T=""

                   QUIT 

               Begin DoDot:1

 +8                IF T="MEDS"

                       KILL ^TMP("OR",$JOB,T)

                       QUIT 

 +9       ; save tab contexts

                   SET CTXT=$PIECE($GET(^TMP("OR",$JOB,T,0)),U,3)

                   IF $LENGTH(CTXT)

                       SET ORT(T,0)="^^"_$SELECT(T="NOTES"&($PIECE(CTXT,";",3)=1):"",1:CTXT)_U_$PIECE(^(0),U,4)

               End DoDot:1

 +10       DO UNLOCK^ORX2(+ORVP)

           KILL ^TMP("OR",$JOB),^TMP("ORNEW",$JOB),^TMP("LRRR",$JOB)

 +11       KILL VALMHDR,ORTAB,ORNEW,OREBUILD,OREBLD

 +12       MERGE ^TMP("OR",$JOB)=ORT

           DO TAB(TAB)

           SET VALMBCK="R"

 +13       QUIT 

 +14      ;

ORDERS(ACTION) ; -- Return order numbers to act on, if action chosen first

 +1        NEW X,Y,DIR,MAX

           IF '$LENGTH($GET(ACTION))

               SET ACTION="act on"

 +2        SET MAX=+$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,2)

           IF MAX'>0

               QUIT "^"

 +3        SET DIR(0)="LAO^1:"_MAX

           SET DIR("A")="Select item(s): "

           IF MAX=1

               SET DIR("B")=1

 +4        SET DIR("?")="Enter the items you wish to "_ACTION_", as a range or list of numbers"

 +5        DO ^DIR

           IF $DATA(DTOUT)!(Y="")

               SET Y="^"

 +6        QUIT Y

 +7       ;

ALL       ; -- Return all items on ORTAB

 +1        NEW X,Y,DIR,MAX

 +2        SET MAX=+$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,2)

           IF MAX'>0

               QUIT ""

 +3        SET DIR(0)="L^1:"_MAX

           SET DIR("V")=""

           SET X="1-"_MAX

           DO ^DIR

 +4        QUIT Y

 +5       ;

SELECT(NMBR) ; -- rev video on selected items

 +1        NEW ORI,ORJ,NUM,ROW,ROWS,VALID

           SET VALID=0

 +2        FOR ORI=1:1:$LENGTH(NMBR,",")

               SET NUM=$PIECE(NMBR,",",ORI)

               IF NUM

                   Begin DoDot:1

 +3                    IF '$LENGTH($PIECE($GET(@VALMAR@("IDX",NUM)),U))

                           WRITE !,NUM_" is not a valid selection."

                           HANG 2

                           QUIT 

 +4                    SET VALID=1

 +5                    SET ROW=$PIECE(@VALMAR@("IDX",NUM),U,2)

                       SET ROWS=$PIECE(^(NUM),U,3)

 +6                    FOR ORJ=ROW:1:(ROW+ROWS-1)

                           IF ORJ'<VALMBG

                               IF ORJ'>(VALMBG+VALM("LINES")-1)

                                   Begin DoDot:2

 +7                                    KILL ^TMP("VALM VIDEO",$JOB,VALMEVL,ORJ)

 +8                                    DO CNTRL^VALM10(ORJ,1,80,IORVON,IORVOFF)

 +9                                    DO WRITE^VALM10(ORJ)

                                   End DoDot:2

                   End DoDot:1

 +10       IF 'VALID

               SET XQORQUIT=1

 +11       QUIT 

 +12      ;

DESELECT(NMBR) ; -- norm video on selected items

 +1        NEW ORI,ORJ,NUM,IFN,ROW,ROWS,ON,OFF,I,IDX

 +2        FOR ORI=1:1:$LENGTH(NMBR,",")

               SET NUM=$PIECE(NMBR,",",ORI)

               IF NUM

                   Begin DoDot:1

 +3       ;invalid NUM

                       SET IDX=$GET(@VALMAR@("IDX",NUM))

                       IF '$LENGTH(IDX)

                           QUIT 

 +4                    SET IFN=$PIECE(IDX,U)

                       SET ROW=$PIECE(IDX,U,2)

                       SET ROWS=$PIECE(IDX,U,3)

 +5                    FOR ORJ=ROW:1:(ROW+ROWS-1)

                           IF ORJ'<VALMBG

                               IF ORJ'>(VALMBG+VALM("LINES")-1)

                                   Begin DoDot:2

 +6       ;deleted

                                       KILL ^TMP("VALM VIDEO",$JOB,VALMEVL,ORJ)

                                       IF '$LENGTH(IFN)

                                           QUIT 

 +7                                    SET ON=IOINHI

                                       SET OFF=IOINORM

 +8       ; flagged

                                       IF ORTAB="ORDERS"

                                           IF $GET(^OR(100,+IFN,8,+$PIECE(IFN,";",2),3))

                                               SET ON=IORVON

                                               SET OFF=IORVOFF

 +9                                    DO CNTRL^VALM10(ORJ,1,5,ON,OFF)

 +10                                   IF ORTAB="ORDERS"

                                           SET I=$FIND(^TMP("OR",$JOB,ORTAB,ORJ,0),"*UNSIGNED*")

                                           IF I

                                               DO CNTRL^VALM10(ORJ,I-10,10,IOINHI,IOINORM)

 +11                                   IF ORTAB="XRAYS"

                                           SET I=$FIND(^TMP("OR",$JOB,ORTAB,ORJ,0),"*ABNORMAL*")

                                           IF I

                                               DO CNTRL^VALM10(ORJ,I-10,10,IOINHI,IOINORM)

 +12                                   IF ORTAB="LABS"

                                           DO CNTRL^VALM10(ORJ,24,2,IOINHI,IOINORM)

 +13                                   IF VALMBCK=""

                                           DO WRITE^VALM10(ORJ)

                                   End DoDot:2

                   End DoDot:1

 +14       QUIT 

 +15      ;

CHANGE    ; -- Change view of current list

 +1        GOTO EN^ORCHANGE

 +2        QUIT 

 +3       ;

REV(ORVP) ; -- Review orders for patient

 +1       ;silent

           IF '$GET(ORVP)

               QUIT 

           IF $DATA(ZTQUEUED)

               QUIT 

           IF $GET(DGQUIET)

               QUIT 

 +2       ;continue if new appt

           IF $DATA(SDAMEVT)

               IF $SELECT(SDAMEVT=1

                   QUIT 

 +3        IF '$$GET^XPAR("ALL","ORPF REVIEW ON PATIENT MVMT")

               QUIT 

 +4       ;CPRS not in user's option menu tree

           IF '$$ACCESS^ORCHTAB

               QUIT 

 +5       ;protect DFN

           NEW X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,DFN

 +6       ; no orders

           SET DFN=+ORVP

           SET ORVP=DFN_";DPT("

           IF '$DATA(^OR(100,"AC",ORVP))

               QUIT 

 +7        SET DIR(0)="YA"

           SET DIR("A")="Review active orders? "

           SET DIR("B")="YES"

 +8        SET DIR("?")="Answer YES to review this patient's active orders"

 +9        DO ^DIR

           IF Y'>0

               QUIT 

           KILL DIR

 +10       DO SLCT1^ORQPT

           IF '$GET(ORVP)

               QUIT 

 +11       SET ORTAB="ORDERS"

           DO EN^VALM("OR CHART")

 +12       QUIT 

 +13      ;

VIEW()    ; -- return line 3 of header w/current view of tab 

 +1        NEW BEGIN,END,ITEMS,STS,TEXT,X

 +2        IF $GET(ORTAB)']""

               QUIT ""

 +3        SET X=$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,3)

           SET TEXT=""

 +4        SET BEGIN=$PIECE(X,";")

           SET END=$PIECE(X,";",2)

           SET STS=$PIECE(X,";",3)

           SET ITEMS=$PIECE(X,";",5)

 +5        IF ORTAB="NOTES"

               IF (STS'=5)

                   SET TEXT=$SELECT(ITEMS:"up to "_ITEMS,1:"all")_$SELECT(STS=1:" notes",STS=2:" unsigned notes",STS=3:" uncosigned notes",STS=4:" signed notes by author",1:"")

 +6       IF '$TEST

               Begin DoDot:1

 +7                IF $LENGTH(BEGIN)!$LENGTH(END)

                       SET TEXT=$$FDATE^VALM1($$DT^ORCHTAB1(BEGIN))_" thru "_$$FDATE^VALM1($$DT^ORCHTAB1(END))

 +8                IF ORTAB="XRAYS"

                       IF ITEMS>0

                           SET TEXT=$SELECT($LENGTH(TEXT):TEXT_", ",1:"")_"limit "_ITEMS

               End DoDot:1

 +9        IF $LENGTH(TEXT)