Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXBDSTP

PXBDSTP.m

Go to the documentation of this file.
  1. PXBDSTP ;ISL/JVS - DISPLAY STOP CODES FROM VISITS ;11/7/96 08:53
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**11**;Aug 12, 1996
  1. ;
  1. ;
  1. EN0 ;---Main entry point
  1. ;
  1. ;
  1. I $D(PXBNPOV) D DSTP4("SAME")
  1. I '$D(PXBNPOV) D DSTP4("BEGIN")
  1. Q
  1. ;
  1. ;
  1. DSTP1 ;--Display the STOP CODE Data
  1. N ENTRY
  1. D UNDON^PXBCC
  1. W !,"No.",?4,"CODE",?13,"DESCRIPTION",?75,$C(32)
  1. W IOEDEOP
  1. D UNDOFF^PXBCC
  1. ;
  1. ;
  1. S J=0 F S J=$O(PXBSAM(J)) Q:J="" D
  1. .S ENTRY=$G(PXBSAM(J)) I $D(PXBNSTP($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
  1. .S ENTRY=$G(PXBSAM(J)) I $D(PXBNSTP($P(ENTRY,"^",2))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
  1. .W !,J,?4,$P(ENTRY,"^",1),?13,$E($P(ENTRY,"^",2),1,30)
  1. ;---Write no entries if none exsist
  1. I '$D(PXBSAM) D NONE^PXBUTL(5)
  1. Q
  1. ;
  1. ;
  1. ;
  1. DSTP4(SIGN) ;--Display the STOP CODE Data
  1. ;
  1. ;SIGN=
  1. ; '+' add 10 to the starting point in ^TMP("PXBDPOV",$J)
  1. ; '-' subtract 10 from the starting point but not less that 0
  1. ; 'BEGIN' start at the beginning
  1. ; 'SAME' start stays where it's at
  1. ; '3'--any number set start to that nuMBER
  1. ;
  1. N PXBSTART
  1. I SIGN="BEGIN" S ^TMP("PXBDSTP",$J,"START")=0,PXBSTART=0
  1. I SIGN="SAME" S PXBSTART=^TMP("PXBDSTP",$J,"START")
  1. I SIGN="+" S PXBSTART=($G(^TMP("PXBDSTP",$J,"START"))+(10)) S:PXBSTART'<PXBCNT PXBSTART=(PXBCNT-(10)) S ^TMP("PXBDSTP",$J,"START")=PXBSTART
  1. 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
  1. 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
  1. 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
  1. ;
  1. ;
  1. I SIGN'="BEGIN" D LOC^PXBCC(3,0) W IOEDEOP
  1. ;
  1. D HEAD
  1. HEAD1 ;--HEADER ON LIST
  1. ;
  1. N ENTRY,J
  1. D UNDON^PXBCC
  1. W !,"No.",?4,"CODE",?13,"DESCRIPTION",?75,$C(32)
  1. W IOEDEOP
  1. D UNDOFF^PXBCC
  1. ;
  1. ;
  1. S J=PXBSTART F S J=$O(PXBSAM(J)) Q:J="" Q:J=(PXBSTART+(11)) D
  1. .S ENTRY=$G(PXBSAM(J)) I $D(PXBNSTP($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
  1. .S ENTRY=$G(PXBSAM(J)) I $D(PXBNSTP($P(ENTRY,"^",2))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
  1. .W !,J,?4,$P(ENTRY,"^",1),?13,$E($P(ENTRY,"^",2),1,30)
  1. I SIGN'="BEGIN" W !!
  1. I '$D(PXBSAM) D NONE^PXBUTL(5)
  1. Q
  1. S HEAD="- - E N C O U N T E R S T O P C O D E S - -"
  1. W IOINHI,!,IOCUU,?(IOM-$L(HEAD))\2,HEAD
  1. W IOINLOW,IOELEOL K HEAD
  1. Q
  1. ;