PXQDVST3 ;ISL/JVS - DISPLAY ENCOUNTERS-SOURCES ;8/29/96 10:30
;;1.0;PCE PATIENT CARE ENCOUNTER;**4**;Aug 12, 1996
;
EN03 ;---THIRD Main entry point
;
;
D DVST43("BEGIN")
W IOINORM
Q
;
;
DVST43(SIGN) ;--Display the ENCOUNTERS
;
;SIGN=
; '+' add 10 to the starting point in ^TMP("PXBDVST",$J)
; '-' subtract 10 from the starting point but not less that 0
; 'BEGIN' start at the beginning
; 'SAME' start stays where it's at
; '3'--any number set start to that number
;
N PXBSTART
I SIGN="BEGIN" S ^TMP("PXBDVST",$J,"START")=0,PXBSTART=0
I SIGN="SAME" S PXBSTART=^TMP("PXBDVST",$J,"START")
I SIGN="+" S PXBSTART=($G(^TMP("PXBDVST",$J,"START"))+(10)) S:PXBSTART'<PXBCNT PXBSTART=(PXBCNT-(10)) S ^TMP("PXBDVST",$J,"START")=PXBSTART
I SIGN="-" S PXBSTART=$G(^TMP("PXBDVST",$J,"START"))-10,^TMP("PXBDVST",$J,"START")=PXBSTART I PXBSTART<0 S PXBSTART=0 S ^TMP("PXBDVST",$J,"START")=0
I +SIGN>0&(SIGN#10) S PXBSTART=$P((SIGN/10),".")*10 S:PXBSTART<10 PXBSTART=0 Q:^TMP("PXBDVST",$J,"START")=PXBSTART S ^TMP("PXBDVST",$J,"START")=PXBSTART
I +SIGN>0&'(SIGN#10) S PXBSTART=(($P((SIGN/10),".")*10)-10) S:PXBSTART<10 PXBSTART=0 Q:^TMP("PXBDVST",$J,"START")=PXBSTART S ^TMP("PXBDVST",$J,"START")=PXBSTART
;
;
I SIGN'="BEGIN" D LOC^PXBCC(3,0) W IOEDEOP
HEAD43 ;--HEADER ON LIST
S HEAD="- - "_$G(PXBCNT)_" E N C O U N T E R S - -"
W IOINHI,!,IOCUU,?(IOM-$L(HEAD))\2,HEAD ;--F W $C(32) Q:$X=(IOM-(4))
W IOINLOW,IOELEOL K HEAD
;
;
N ENTRY,J
D UNDON^PXBCC
W !,"No.",?5,"IEN",?15,"DATE/TIME",?31,"CLINIC",?38,"USER",?45,"OPTION",?55,"PACKAGE",?65,"SOURCE"
W IOEDEOP
D UNDOFF^PXBCC
I '$D(^TMP("PXBSAM",$J)) D NONE^PXBUTL(6)
;
S J=PXBSTART F S J=$O(^TMP("PXBSAM",$J,J)) Q:J="" Q:J=(PXBSTART+(11)) D
.S ENTRY=$G(^TMP("PXBSAM",$J,J)),PXBHIGH=$S($G(PXBHIGH)>J:$G(PXBHIGH),$G(PXBHIGH)<J:J,1:$G(PXBHIGH))
.W !,J,?5,$P(ENTRY,"^",1),?15,$P(ENTRY,"^",2),?32,$P(ENTRY,"^",3),?39,$P(ENTRY,"^",4),?45,$P(ENTRY,"^",5),?55,$P(ENTRY,"^",6),?65,$P(ENTRY,"^",7)
I J="",$G(PXBCNT)'<1 D HELP1^PXBUTL1("LST")
I SIGN'="BEGIN" W !!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXQDVST3 2092 printed Nov 22, 2024@17:40 Page 2
PXQDVST3 ;ISL/JVS - DISPLAY ENCOUNTERS-SOURCES ;8/29/96 10:30
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**4**;Aug 12, 1996
+2 ;
EN03 ;---THIRD Main entry point
+1 ;
+2 ;
+3 DO DVST43("BEGIN")
+4 WRITE IOINORM
+5 QUIT
+6 ;
+7 ;
DVST43(SIGN) ;--Display the ENCOUNTERS
+1 ;
+2 ;SIGN=
+3 ; '+' add 10 to the starting point in ^TMP("PXBDVST",$J)
+4 ; '-' subtract 10 from the starting point but not less that 0
+5 ; 'BEGIN' start at the beginning
+6 ; 'SAME' start stays where it's at
+7 ; '3'--any number set start to that number
+8 ;
+9 NEW PXBSTART
+10 IF SIGN="BEGIN"
SET ^TMP("PXBDVST",$JOB,"START")=0
SET PXBSTART=0
+11 IF SIGN="SAME"
SET PXBSTART=^TMP("PXBDVST",$JOB,"START")
+12 IF SIGN="+"
SET PXBSTART=($GET(^TMP("PXBDVST",$JOB,"START"))+(10))
if PXBSTART'<PXBCNT
SET PXBSTART=(PXBCNT-(10))
SET ^TMP("PXBDVST",$JOB,"START")=PXBSTART
+13 IF SIGN="-"
SET PXBSTART=$GET(^TMP("PXBDVST",$JOB,"START"))-10
SET ^TMP("PXBDVST",$JOB,"START")=PXBSTART
IF PXBSTART<0
SET PXBSTART=0
SET ^TMP("PXBDVST",$JOB,"START")=0
+14 IF +SIGN>0&(SIGN#10)
SET PXBSTART=$PIECE((SIGN/10),".")*10
if PXBSTART<10
SET PXBSTART=0
if ^TMP("PXBDVST",$JOB,"START")=PXBSTART
QUIT
SET ^TMP("PXBDVST",$JOB,"START")=PXBSTART
+15 IF +SIGN>0&'(SIGN#10)
SET PXBSTART=(($PIECE((SIGN/10),".")*10)-10)
if PXBSTART<10
SET PXBSTART=0
if ^TMP("PXBDVST",$JOB,"START")=PXBSTART
QUIT
SET ^TMP("PXBDVST",$JOB,"START")=PXBSTART
+16 ;
+17 ;
+18 IF SIGN'="BEGIN"
DO LOC^PXBCC(3,0)
WRITE IOEDEOP
HEAD43 ;--HEADER ON LIST
+1 SET HEAD="- - "_$GET(PXBCNT)_" E N C O U N T E R S - -"
+2 ;--F W $C(32) Q:$X=(IOM-(4))
WRITE IOINHI,!,IOCUU,?(IOM-$LENGTH(HEAD))\2,HEAD
+3 WRITE IOINLOW,IOELEOL
KILL HEAD
+4 ;
+5 ;
+6 NEW ENTRY,J
+7 DO UNDON^PXBCC
+8 WRITE !,"No.",?5,"IEN",?15,"DATE/TIME",?31,"CLINIC",?38,"USER",?45,"OPTION",?55,"PACKAGE",?65,"SOURCE"
+9 WRITE IOEDEOP
+10 DO UNDOFF^PXBCC
+11 IF '$DATA(^TMP("PXBSAM",$JOB))
DO NONE^PXBUTL(6)
+12 ;
+13 SET J=PXBSTART
FOR
SET J=$ORDER(^TMP("PXBSAM",$JOB,J))
if J=""
QUIT
if J=(PXBSTART+(11))
QUIT
Begin DoDot:1
+14 SET ENTRY=$GET(^TMP("PXBSAM",$JOB,J))
SET PXBHIGH=$SELECT($GET(PXBHIGH)>J:$GET(PXBHIGH),$GET(PXBHIGH)<J:J,1:$GET(PXBHIGH))
+15 WRITE !,J,?5,$PIECE(ENTRY,"^",1),?15,$PIECE(ENTRY,"^",2),?32,$PIECE(ENTRY,"^",3),?39,$PIECE(ENTRY,"^",4),?45,$PIECE(ENTRY,"^",5),?55,$PIECE(ENTRY,"^",6),?65,$PIECE(ENTRY,"^",7)
End DoDot:1
+16 IF J=""
IF $GET(PXBCNT)'<1
DO HELP1^PXBUTL1("LST")
+17 IF SIGN'="BEGIN"
WRITE !!
+18 QUIT
