PXBDSTP ;ISL/JVS - DISPLAY STOP CODES FROM VISITS ;11/7/96 08:53
;;1.0;PCE PATIENT CARE ENCOUNTER;**11**;Aug 12, 1996
;
;
EN0 ;---Main entry point
;
;
I $D(PXBNPOV) D DSTP4("SAME")
I '$D(PXBNPOV) D DSTP4("BEGIN")
Q
;
;
DSTP1 ;--Display the STOP CODE Data
N ENTRY
D UNDON^PXBCC
W !,"No.",?4,"CODE",?13,"DESCRIPTION",?75,$C(32)
W IOEDEOP
D UNDOFF^PXBCC
;
;
S J=0 F S J=$O(PXBSAM(J)) Q:J="" D
.S ENTRY=$G(PXBSAM(J)) I $D(PXBNSTP($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
.S ENTRY=$G(PXBSAM(J)) I $D(PXBNSTP($P(ENTRY,"^",2))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
.W !,J,?4,$P(ENTRY,"^",1),?13,$E($P(ENTRY,"^",2),1,30)
;---Write no entries if none exsist
I '$D(PXBSAM) D NONE^PXBUTL(5)
Q
;
;
;
DSTP4(SIGN) ;--Display the STOP CODE Data
;
;SIGN=
; '+' add 10 to the starting point in ^TMP("PXBDPOV",$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("PXBDSTP",$J,"START")=0,PXBSTART=0
I SIGN="SAME" S PXBSTART=^TMP("PXBDSTP",$J,"START")
I SIGN="+" S PXBSTART=($G(^TMP("PXBDSTP",$J,"START"))+(10)) S:PXBSTART'<PXBCNT PXBSTART=(PXBCNT-(10)) S ^TMP("PXBDSTP",$J,"START")=PXBSTART
I SIGN="-" S PXBSTART=$G(^TMP("PXBDSTP",$J,"START"))-10,^TMP("PXBDSTP",$J,"START")=PXBSTART I PXBSTART<0 S PXBSTART=0 S ^TMP("PXBDSTP",$J,"START")=0
I +SIGN>0&(SIGN#10) S PXBSTART=$P((SIGN/10),".")*10 S:PXBSTART<10 PXBSTART=0 Q:^TMP("PXBDSTP",$J,"START")=PXBSTART S ^TMP("PXBDSTP",$J,"START")=PXBSTART
I +SIGN>0&'(SIGN#10) S PXBSTART=(($P((SIGN/10),".")*10)-10) S:PXBSTART<10 PXBSTART=0 Q:^TMP("PXBDSTP",$J,"START")=PXBSTART S ^TMP("PXBDSTP",$J,"START")=PXBSTART
;
;
I SIGN'="BEGIN" D LOC^PXBCC(3,0) W IOEDEOP
;
D HEAD
HEAD1 ;--HEADER ON LIST
;
N ENTRY,J
D UNDON^PXBCC
W !,"No.",?4,"CODE",?13,"DESCRIPTION",?75,$C(32)
W IOEDEOP
D UNDOFF^PXBCC
;
;
S J=PXBSTART F S J=$O(PXBSAM(J)) Q:J="" Q:J=(PXBSTART+(11)) D
.S ENTRY=$G(PXBSAM(J)) I $D(PXBNSTP($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
.S ENTRY=$G(PXBSAM(J)) I $D(PXBNSTP($P(ENTRY,"^",2))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
.W !,J,?4,$P(ENTRY,"^",1),?13,$E($P(ENTRY,"^",2),1,30)
I SIGN'="BEGIN" W !!
I '$D(PXBSAM) D NONE^PXBUTL(5)
Q
HEAD ;--HEADER ON LIST
S HEAD="- - E N C O U N T E R S T O P C O D E S - -"
W IOINHI,!,IOCUU,?(IOM-$L(HEAD))\2,HEAD
W IOINLOW,IOELEOL K HEAD
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBDSTP 2547 printed Dec 13, 2024@02:26:29 Page 2
PXBDSTP ;ISL/JVS - DISPLAY STOP CODES FROM VISITS ;11/7/96 08:53
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11**;Aug 12, 1996
+2 ;
+3 ;
EN0 ;---Main entry point
+1 ;
+2 ;
+3 IF $DATA(PXBNPOV)
DO DSTP4("SAME")
+4 IF '$DATA(PXBNPOV)
DO DSTP4("BEGIN")
+5 QUIT
+6 ;
+7 ;
DSTP1 ;--Display the STOP CODE Data
+1 NEW ENTRY
+2 DO UNDON^PXBCC
+3 WRITE !,"No.",?4,"CODE",?13,"DESCRIPTION",?75,$CHAR(32)
+4 WRITE IOEDEOP
+5 DO UNDOFF^PXBCC
+6 ;
+7 ;
+8 SET J=0
FOR
SET J=$ORDER(PXBSAM(J))
if J=""
QUIT
Begin DoDot:1
+9 SET ENTRY=$GET(PXBSAM(J))
IF $DATA(PXBNSTP($PIECE(ENTRY,"^",1)))
SET $PIECE(ENTRY,"^",1)=$PIECE(ENTRY,"^",1)_"*"
+10 SET ENTRY=$GET(PXBSAM(J))
IF $DATA(PXBNSTP($PIECE(ENTRY,"^",2)))
SET $PIECE(ENTRY,"^",1)=$PIECE(ENTRY,"^",1)_"*"
+11 WRITE !,J,?4,$PIECE(ENTRY,"^",1),?13,$EXTRACT($PIECE(ENTRY,"^",2),1,30)
End DoDot:1
+12 ;---Write no entries if none exsist
+13 IF '$DATA(PXBSAM)
DO NONE^PXBUTL(5)
+14 QUIT
+15 ;
+16 ;
+17 ;
DSTP4(SIGN) ;--Display the STOP CODE Data
+1 ;
+2 ;SIGN=
+3 ; '+' add 10 to the starting point in ^TMP("PXBDPOV",$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("PXBDSTP",$JOB,"START")=0
SET PXBSTART=0
+11 IF SIGN="SAME"
SET PXBSTART=^TMP("PXBDSTP",$JOB,"START")
+12 IF SIGN="+"
SET PXBSTART=($GET(^TMP("PXBDSTP",$JOB,"START"))+(10))
if PXBSTART'<PXBCNT
SET PXBSTART=(PXBCNT-(10))
SET ^TMP("PXBDSTP",$JOB,"START")=PXBSTART
+13 IF SIGN="-"
SET PXBSTART=$GET(^TMP("PXBDSTP",$JOB,"START"))-10
SET ^TMP("PXBDSTP",$JOB,"START")=PXBSTART
IF PXBSTART<0
SET PXBSTART=0
SET ^TMP("PXBDSTP",$JOB,"START")=0
+14 IF +SIGN>0&(SIGN#10)
SET PXBSTART=$PIECE((SIGN/10),".")*10
if PXBSTART<10
SET PXBSTART=0
if ^TMP("PXBDSTP",$JOB,"START")=PXBSTART
QUIT
SET ^TMP("PXBDSTP",$JOB,"START")=PXBSTART
+15 IF +SIGN>0&'(SIGN#10)
SET PXBSTART=(($PIECE((SIGN/10),".")*10)-10)
if PXBSTART<10
SET PXBSTART=0
if ^TMP("PXBDSTP",$JOB,"START")=PXBSTART
QUIT
SET ^TMP("PXBDSTP",$JOB,"START")=PXBSTART
+16 ;
+17 ;
+18 IF SIGN'="BEGIN"
DO LOC^PXBCC(3,0)
WRITE IOEDEOP
+19 ;
+20 DO HEAD
HEAD1 ;--HEADER ON LIST
+1 ;
+2 NEW ENTRY,J
+3 DO UNDON^PXBCC
+4 WRITE !,"No.",?4,"CODE",?13,"DESCRIPTION",?75,$CHAR(32)
+5 WRITE IOEDEOP
+6 DO UNDOFF^PXBCC
+7 ;
+8 ;
+9 SET J=PXBSTART
FOR
SET J=$ORDER(PXBSAM(J))
if J=""
QUIT
if J=(PXBSTART+(11))
QUIT
Begin DoDot:1
+10 SET ENTRY=$GET(PXBSAM(J))
IF $DATA(PXBNSTP($PIECE(ENTRY,"^",1)))
SET $PIECE(ENTRY,"^",1)=$PIECE(ENTRY,"^",1)_"*"
+11 SET ENTRY=$GET(PXBSAM(J))
IF $DATA(PXBNSTP($PIECE(ENTRY,"^",2)))
SET $PIECE(ENTRY,"^",1)=$PIECE(ENTRY,"^",1)_"*"
+12 WRITE !,J,?4,$PIECE(ENTRY,"^",1),?13,$EXTRACT($PIECE(ENTRY,"^",2),1,30)
End DoDot:1
+13 IF SIGN'="BEGIN"
WRITE !!
+14 IF '$DATA(PXBSAM)
DO NONE^PXBUTL(5)
+15 QUIT
HEAD ;--HEADER ON LIST
+1 SET HEAD="- - E N C O U N T E R S T O P C O D E S - -"
+2 WRITE IOINHI,!,IOCUU,?(IOM-$LENGTH(HEAD))\2,HEAD
+3 WRITE IOINLOW,IOELEOL
KILL HEAD
+4 QUIT
+5 ;
