VistA-WorldVistAEHR/r/AUTOMATED_MED_INFO_EXCHANGE.../DVBCLMU5.m

42 lines
1.1 KiB
Mathematica

DVBCLMU5 ;ALB/CMM LIST MANAGER PROTOCOLS ;11/12/93
;;2.7;AMIE;;Apr 10, 1995
;
;Jumping to a new exam from within the view screen Protocol
;Super Quit Protocol
;Removal of previously viewed screens that have been disgarded
;
;
INIT ;
;JUMP PROTOCOL
I VWQRY>5 W !,"Can't jump again until you close another screen." S VALMBCK="R" D PAUSE^VALM1 Q
I DVBAC="O" W !,"CAN'T JUMP FROM AN OVERVIEW" S VALMBCK="R" D PAUSE^VALM1 Q
S DVBCJMP="Y",QUIT="N"
S DVBCCNT=DVBCCNT+1,VWQRY=VWQRY+1,DVBCHLD="DVBCVIEW,"_$J_","_VWQRY
D A^DVBCPGD
I '$D(QUIT) Q
I $D(DVBCSPR) G EXIT3^DVBCPGD1
I QUIT'="Y" S DVBCTEMP="Y"
I QUIT="Y" S DVBCCNT=DVBCCNT-1
I VWQRY>1 S VALMBCK="R"
I VWQRY<2 S VWQRY=2,DVBCHLD="DVBCVIEW,"_$J_","_VWQRY,DVBCCNT=1,TQUIT="Y"
I DVBCCNT<3 K DVBCJMP
S VALMBG=1,VWLINE=1
Q
REMOVE(TQRY) ;
;REMOVES ALL REMAINING WINDOWS
N WORD
I '$D(^TMP("DVBCVIEW,"_$J_","_TQRY)) Q
K ^TMP("DVBCVIEW",$J,TQRY)
F S WORD=$O(^TMP("DVBC",$J,"~"_TQRY)) Q:WORD="" K ^TMP("DVBC",$J,WORD),^TMP("DVBC",$J,TQRY)
Q
QUIT ;
;SUPER QUIT PROTOCOL
N HOLD
S DVBCSPR="Y",HOLD=VWQRY
F Q:HOLD=1 D
.D REMOVE(HOLD)
.S HOLD=HOLD-1
S VWQRY=0
S QUIT="Y"
Q