ORCHANG3 ;SLC/MKB - Change view by event ; 08 May 2002 2:12 PM
;;3.0;ORDER ENTRY/RESULTS REPORTING;**141**;Dec 17, 1997
;
EVT ; -- Select new event
N X,Y,HDR,DOMAIN,DEFAULT,I,PROMPT,HELP,EVT
S HDR=$P($G(^TMP("OR",$J,ORTAB,0)),U,3),DEFAULT=""
D LIST^OREVNTX(.DOMAIN,+ORVP)
I $G(DOMAIN(0))<1 W !,"No events available for this patient.",! H 1 Q
F I=1:1:DOMAIN(0) S X=$P(DOMAIN(I),U,2)_" "_$$FMTE^XLFDT($P(DOMAIN(I),U,3),"2P"),DOMAIN("B",$$UP^XLFSTR(X))=I
S PROMPT="Select Patient Event: "
S HELP="Enter the event whose orders you wish to see listed here."
D EN Q:Y="^" S EVT=+$G(DOMAIN(Y))
S:EVT $P(HDR,";",3)="",$P(HDR,";",8)=EVT,DEFAULT=""
I EVT<1,'$P(HDR,";",3) S DEFAULT=1
S $P(^TMP("OR",$J,ORTAB,0),U,3,4)=HDR_U_DEFAULT
Q
;
EN ; -- Select new event via DOMAIN(), PROMPT, DEFAULT, HELP
N DONE S DONE=0,Y="" F D Q:DONE
. W !,PROMPT_$S($L(DEFAULT):DEFAULT_"//",1:"")
. R X:DTIME S:'$T X="^" I X["^" S Y="^",DONE=1 Q
. S:X="" X=DEFAULT I X="" S Y="^",DONE=1 Q
. I X="@" S Y="",DONE=1 Q
. I X["?" W !!,HELP D LIST Q
. D I 'Y W $C(7),!,HELP Q
. . N XP,XY,CNT,MATCH,DIR,I
. . S X=$$UP^XLFSTR(X),Y=+$G(DOMAIN("B",X)) Q:Y ; done
. . S CNT=0,XP=X F S XP=$O(DOMAIN("B",XP)) Q:XP="" Q:$E(XP,1,$L(X))'=X S CNT=CNT+1,XY=+DOMAIN("B",XP),MATCH(CNT)=XY_U_$P(DOMAIN(XY),U,2)
. . Q:'CNT
. . I CNT=1 S Y=+MATCH(1),XP=$P(MATCH(1),U,2) W $E(XP,$L(X)+1,$L(XP)) Q
. . S DIR(0)="NAO^1:"_CNT,DIR("A")="Select 1-"_CNT_": "
. . F I=1:1:CNT S DIR("A",I)=$J(I,3)_" "_$P(MATCH(I),U,2)
. . S DIR("?")="Select the desired value, by number"
. . I CNT>3 D FULL^VALM1 S VALMBCK="R" ;need to scroll
. . D ^DIR I $D(DIRUT) S Y="" Q
. . S Y=+MATCH(Y) W " "_$P(DOMAIN(Y),U,2)
. S DONE=1
Q
;
LIST ; -- List order events in DOMAIN
N I,Z,CNT,DONE D FULL^VALM1 S VALMBCK="R"
S CNT=0 W !,"Choose from:"
F I=1:1:DOMAIN(0) D Q:$G(DONE)
. S CNT=CNT+1 W ! I CNT>(IOSL-3) D Q:$G(DONE)
.. W ?3,"'^' TO STOP: " R Z:DTIME S:'$T!(Z["^") DONE=1 S CNT=1
. W $C(13)," "_$P(DOMAIN(I),U,2)_" "_$$FMTE^XLFDT($P(DOMAIN(I),U,3),"2P")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCHANG3 2088 printed Sep 23, 2025@20:04:39 Page 2
ORCHANG3 ;SLC/MKB - Change view by event ; 08 May 2002 2:12 PM
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141**;Dec 17, 1997
+2 ;
EVT ; -- Select new event
+1 NEW X,Y,HDR,DOMAIN,DEFAULT,I,PROMPT,HELP,EVT
+2 SET HDR=$PIECE($GET(^TMP("OR",$JOB,ORTAB,0)),U,3)
SET DEFAULT=""
+3 DO LIST^OREVNTX(.DOMAIN,+ORVP)
+4 IF $GET(DOMAIN(0))<1
WRITE !,"No events available for this patient.",!
HANG 1
QUIT
+5 FOR I=1:1:DOMAIN(0)
SET X=$PIECE(DOMAIN(I),U,2)_" "_$$FMTE^XLFDT($PIECE(DOMAIN(I),U,3),"2P")
SET DOMAIN("B",$$UP^XLFSTR(X))=I
+6 SET PROMPT="Select Patient Event: "
+7 SET HELP="Enter the event whose orders you wish to see listed here."
+8 DO EN
if Y="^"
QUIT
SET EVT=+$GET(DOMAIN(Y))
+9 if EVT
SET $PIECE(HDR,";",3)=""
SET $PIECE(HDR,";",8)=EVT
SET DEFAULT=""
+10 IF EVT<1
IF '$PIECE(HDR,";",3)
SET DEFAULT=1
+11 SET $PIECE(^TMP("OR",$JOB,ORTAB,0),U,3,4)=HDR_U_DEFAULT
+12 QUIT
+13 ;
EN ; -- Select new event via DOMAIN(), PROMPT, DEFAULT, HELP
+1 NEW DONE
SET DONE=0
SET Y=""
FOR
Begin DoDot:1
+2 WRITE !,PROMPT_$SELECT($LENGTH(DEFAULT):DEFAULT_"//",1:"")
+3 READ X:DTIME
if '$TEST
SET X="^"
IF X["^"
SET Y="^"
SET DONE=1
QUIT
+4 if X=""
SET X=DEFAULT
IF X=""
SET Y="^"
SET DONE=1
QUIT
+5 IF X="@"
SET Y=""
SET DONE=1
QUIT
+6 IF X["?"
WRITE !!,HELP
DO LIST
QUIT
+7 Begin DoDot:2
+8 NEW XP,XY,CNT,MATCH,DIR,I
+9 ; done
SET X=$$UP^XLFSTR(X)
SET Y=+$GET(DOMAIN("B",X))
if Y
QUIT
+10 SET CNT=0
SET XP=X
FOR
SET XP=$ORDER(DOMAIN("B",XP))
if XP=""
QUIT
if $EXTRACT(XP,1,$LENGTH(X))'=X
QUIT
SET CNT=CNT+1
SET XY=+DOMAIN("B",XP)
SET MATCH(CNT)=XY_U_$PIECE(DOMAIN(XY),U,2)
+11 if 'CNT
QUIT
+12 IF CNT=1
SET Y=+MATCH(1)
SET XP=$PIECE(MATCH(1),U,2)
WRITE $EXTRACT(XP,$LENGTH(X)+1,$LENGTH(XP))
QUIT
+13 SET DIR(0)="NAO^1:"_CNT
SET DIR("A")="Select 1-"_CNT_": "
+14 FOR I=1:1:CNT
SET DIR("A",I)=$JUSTIFY(I,3)_" "_$PIECE(MATCH(I),U,2)
+15 SET DIR("?")="Select the desired value, by number"
+16 ;need to scroll
IF CNT>3
DO FULL^VALM1
SET VALMBCK="R"
+17 DO ^DIR
IF $DATA(DIRUT)
SET Y=""
QUIT
+18 SET Y=+MATCH(Y)
WRITE " "_$PIECE(DOMAIN(Y),U,2)
End DoDot:2
IF 'Y
WRITE $CHAR(7),!,HELP
QUIT
+19 SET DONE=1
End DoDot:1
if DONE
QUIT
+20 QUIT
+21 ;
LIST ; -- List order events in DOMAIN
+1 NEW I,Z,CNT,DONE
DO FULL^VALM1
SET VALMBCK="R"
+2 SET CNT=0
WRITE !,"Choose from:"
+3 FOR I=1:1:DOMAIN(0)
Begin DoDot:1
+4 SET CNT=CNT+1
WRITE !
IF CNT>(IOSL-3)
Begin DoDot:2
+5 WRITE ?3,"'^' TO STOP: "
READ Z:DTIME
if '$TEST!(Z["^")
SET DONE=1
SET CNT=1
End DoDot:2
if $GET(DONE)
QUIT
+6 WRITE $CHAR(13)," "_$PIECE(DOMAIN(I),U,2)_" "_$$FMTE^XLFDT($PIECE(DOMAIN(I),U,3),"2P")
End DoDot:1
if $GET(DONE)
QUIT
+7 QUIT
