DGPTFM71 ;ALB/MJK - Display Phys. MPCR mvts ; 12/12/06 11:49am
;;5.3;Registration;**729**;Aug 13, 1993;Build 59
;
EN ; -- entry point for MPCR display option
W ! S DIC="^DGPT(",DIC(0)="AEMZQ",DIC("S")="I '$P(^(0),U,4),$P(^(0),U,11)=1" D ^DIC K DIC
G ENQ:+Y<0 S DGPTF0=Y(0),PTF=+Y,DFN=+Y(0) D UPDT^DGPTUTL:'$P(Y(0),U,6)
S Y=$S($D(^DGPT(PTF,70)):+^(70),1:"") D FMT^DGPTUTL
S DGPR="",DGBRCH="OPT^DGPTFM71" K DGBLK S $P(DGBLK," ",80)=""
S X=$S($D(^DPT(DFN,0)):^(0),1:""),HEAD=$E($P(X,U)_" ("_$E($P(X,U,9),6,10)_")"_DGBLK,1,30)_"Adm: ",Y=$P(DGPTF0,U,2) X ^DD("DD") S HEAD=HEAD_Y_" to " S Y=$S($D(^DGPT(PTF,70)):+^(70),1:"") S:'Y Y="Present" X:Y ^DD("DD") S HEAD=HEAD_Y_" "
;S X="IORVON;IORVOFF" D ENDR^%ZISS S DGVI=IORVON,DGVO=IORVOFF K IORVON,IORVOFF
S (DGVI,DGVO)=""""""
D EN^DGPTFM7 G EN
ENQ K DGPR,HEAD,DFN,DGPTFMT,DGVI,DGVO,DGBRCH,PTF,DIC,DGPTF0,DGBLK Q
;
OPT I DGC'<DGTOT W !,"Enter <RET> to stop"
I DGC<DGTOT W !,"Enter <RET> to display more MPCR information"
I DGC>DGMAX W:$X>40 !?2 W " or 'B' to display from beginning"
W ": <RET>// " R X:DTIME
I '$T!(X="^") G OPTQ
I X="" G LOOP^DGPTFM7:DGC<DGTOT,OPTQ
I DGC>DGMAX,X="B" S (DGC,DGLDT)=0 G LOOP^DGPTFM7
W !
I DGC<DGTOT W !,"Press return to see more MPCR information"
I DGC'<DGTOT W !,"Press return to stop the display"
I DGC>DGMAX W !,"Enter 'B' to display table from beginning again"
W !," '^' to stop the display",!
G OPT
OPTQ D KILL^DGPTFM7 Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTFM71 1468 printed Dec 13, 2024@02:52:26 Page 2
DGPTFM71 ;ALB/MJK - Display Phys. MPCR mvts ; 12/12/06 11:49am
+1 ;;5.3;Registration;**729**;Aug 13, 1993;Build 59
+2 ;
EN ; -- entry point for MPCR display option
+1 WRITE !
SET DIC="^DGPT("
SET DIC(0)="AEMZQ"
SET DIC("S")="I '$P(^(0),U,4),$P(^(0),U,11)=1"
DO ^DIC
KILL DIC
+2 if +Y<0
GOTO ENQ
SET DGPTF0=Y(0)
SET PTF=+Y
SET DFN=+Y(0)
if '$PIECE(Y(0),U,6)
DO UPDT^DGPTUTL
+3 SET Y=$SELECT($DATA(^DGPT(PTF,70)):+^(70),1:"")
DO FMT^DGPTUTL
+4 SET DGPR=""
SET DGBRCH="OPT^DGPTFM71"
KILL DGBLK
SET $PIECE(DGBLK," ",80)=""
+5 SET X=$SELECT($DATA(^DPT(DFN,0)):^(0),1:"")
SET HEAD=$EXTRACT($PIECE(X,U)_" ("_$EXTRACT($PIECE(X,U,9),6,10)_")"_DGBLK,1,30)_"Adm: "
SET Y=$PIECE(DGPTF0,U,2)
XECUTE ^DD("DD")
SET HEAD=HEAD_Y_" to "
SET Y=$SELECT($DATA(^DGPT(PTF,70)):+^(70),1:"")
if 'Y
SET Y="Present"
if Y
XECUTE ^DD("DD")
SET HEAD=HEAD_Y_" "
+6 ;S X="IORVON;IORVOFF" D ENDR^%ZISS S DGVI=IORVON,DGVO=IORVOFF K IORVON,IORVOFF
+7 SET (DGVI,DGVO)=""""""
+8 DO EN^DGPTFM7
GOTO EN
ENQ KILL DGPR,HEAD,DFN,DGPTFMT,DGVI,DGVO,DGBRCH,PTF,DIC,DGPTF0,DGBLK
QUIT
+1 ;
OPT IF DGC'<DGTOT
WRITE !,"Enter <RET> to stop"
+1 IF DGC<DGTOT
WRITE !,"Enter <RET> to display more MPCR information"
+2 IF DGC>DGMAX
if $X>40
WRITE !?2
WRITE " or 'B' to display from beginning"
+3 WRITE ": <RET>// "
READ X:DTIME
+4 IF '$TEST!(X="^")
GOTO OPTQ
+5 IF X=""
if DGC<DGTOT
GOTO LOOP^DGPTFM7
GOTO OPTQ
+6 IF DGC>DGMAX
IF X="B"
SET (DGC,DGLDT)=0
GOTO LOOP^DGPTFM7
+7 WRITE !
+8 IF DGC<DGTOT
WRITE !,"Press return to see more MPCR information"
+9 IF DGC'<DGTOT
WRITE !,"Press return to stop the display"
+10 IF DGC>DGMAX
WRITE !,"Enter 'B' to display table from beginning again"
+11 WRITE !," '^' to stop the display",!
+12 GOTO OPT
OPTQ DO KILL^DGPTFM7
QUIT
+1 ;
