- 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 Feb 18, 2025@23:52:47 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 ;