source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBDSTP.m@ 1679

Last change on this file since 1679 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 2.4 KB
Line 
1PXBDSTP ;ISL/JVS - DISPLAY STOP CODES FROM VISITS ;11/7/96 08:53
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11**;Aug 12, 1996
3 ;
4 ;
5EN0 ;---Main entry point
6 ;
7 ;
8 I $D(PXBNPOV) D DSTP4("SAME")
9 I '$D(PXBNPOV) D DSTP4("BEGIN")
10 Q
11 ;
12 ;
13DSTP1 ;--Display the STOP CODE Data
14 N ENTRY
15 D UNDON^PXBCC
16 W !,"No.",?4,"CODE",?13,"DESCRIPTION",?75,$C(32)
17 W IOEDEOP
18 D UNDOFF^PXBCC
19 ;
20 ;
21 S J=0 F S J=$O(PXBSAM(J)) Q:J="" D
22 .S ENTRY=$G(PXBSAM(J)) I $D(PXBNSTP($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
23 .S ENTRY=$G(PXBSAM(J)) I $D(PXBNSTP($P(ENTRY,"^",2))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
24 .W !,J,?4,$P(ENTRY,"^",1),?13,$E($P(ENTRY,"^",2),1,30)
25 ;---Write no entries if none exsist
26 I '$D(PXBSAM) D NONE^PXBUTL(5)
27 Q
28 ;
29 ;
30 ;
31DSTP4(SIGN) ;--Display the STOP CODE Data
32 ;
33 ;SIGN=
34 ; '+' add 10 to the starting point in ^TMP("PXBDPOV",$J)
35 ; '-' subtract 10 from the starting point but not less that 0
36 ; 'BEGIN' start at the beginning
37 ; 'SAME' start stays where it's at
38 ; '3'--any number set start to that nuMBER
39 ;
40 N PXBSTART
41 I SIGN="BEGIN" S ^TMP("PXBDSTP",$J,"START")=0,PXBSTART=0
42 I SIGN="SAME" S PXBSTART=^TMP("PXBDSTP",$J,"START")
43 I SIGN="+" S PXBSTART=($G(^TMP("PXBDSTP",$J,"START"))+(10)) S:PXBSTART'<PXBCNT PXBSTART=(PXBCNT-(10)) S ^TMP("PXBDSTP",$J,"START")=PXBSTART
44 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
45 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
46 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
47 ;
48 ;
49 I SIGN'="BEGIN" D LOC^PXBCC(3,0) W IOEDEOP
50 ;
51 D HEAD
52HEAD1 ;--HEADER ON LIST
53 ;
54 N ENTRY,J
55 D UNDON^PXBCC
56 W !,"No.",?4,"CODE",?13,"DESCRIPTION",?75,$C(32)
57 W IOEDEOP
58 D UNDOFF^PXBCC
59 ;
60 ;
61 S J=PXBSTART F S J=$O(PXBSAM(J)) Q:J="" Q:J=(PXBSTART+(11)) D
62 .S ENTRY=$G(PXBSAM(J)) I $D(PXBNSTP($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
63 .S ENTRY=$G(PXBSAM(J)) I $D(PXBNSTP($P(ENTRY,"^",2))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
64 .W !,J,?4,$P(ENTRY,"^",1),?13,$E($P(ENTRY,"^",2),1,30)
65 I SIGN'="BEGIN" W !!
66 I '$D(PXBSAM) D NONE^PXBUTL(5)
67 Q
68HEAD ;--HEADER ON LIST
69 S HEAD="- - E N C O U N T E R S T O P C O D E S - -"
70 W IOINHI,!,IOCUU,?(IOM-$L(HEAD))\2,HEAD
71 W IOINLOW,IOELEOL K HEAD
72 Q
73 ;
Note: See TracBrowser for help on using the repository browser.