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

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

initial load of WorldVistAEHR
File size: 2.9 KB
Line 
1PXBDPL ;ISL/JVS - DISPLAY PROBLEM LIST ENTRIES ;5/21/96 11:30
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
3 ;
4 ;
5EN1 ;-FIRST Entry Point
6 N OK,RDATA,QUIT
7 N PXBSAMPL,PXBKYPL,PXBSKYPL
8 D PL^PXBGPL(PATIENT),EN0
9ENA ;--
10 S QUIT=0
11 I PXBCNTPL'>10 G ENB
12 I PXBCNTPL>10 D
13 .D LOC^PXBCC(15,1)
14 .W !!,"Enter a '+' for NEXT page or '-' for PREVIOUS page."
15 .W !,"Select a DIAGNOSIS from the Active PROBLEM lIST: "
16 .R OK:DTIME
17 .I OK["?" D WIN17^PXBCC(PXBCNTPL),HELP^PXBUTL0("PL1")
18 .I OK]"","+-"[OK D DPOV4(OK)
19 .I OK]"","+-"'[OK,OK?.N,OK>0,OK<(PXBCNTPL+(1)) S RDATA=PXBSAMPL(OK) S QUIT=1
20 .I "^"[OK S QUIT=1 S DATA="" Q
21 I QUIT=1 G ENXIT
22 G ENA
23 Q
24ENB ;---
25 I PXBCNTPL'>10 D
26 .W !!,"Select a DIAGNOSIS from the Active PROBLEM lIST: "
27 .R OK:DTIME
28 .I OK["?" D WIN17^PXBCC(PXBCNTPL),HELP^PXBUTL0("PL11")
29 .I OK]"",OK?.N,OK>0,OK<(PXBCNTPL+(1)) S RDATA=PXBSAMPL(OK) S QUIT=1
30 .I "^"[OK S QUIT=1 S DATA="" Q
31 I QUIT=1 G ENXIT
32 G ENB
33ENXIT ;EXIT
34 K PXBPLA
35 I $D(RDATA),$G(RDATA) S (DATA,EDATA)=$P(RDATA,"^",1)
36 ;--Go Back to the POV list
37 D LOC^PXBCC(3,1) W IOEDEOP D POV^PXBGPOV(PXBVST),EN0^PXBDPOV W !!
38 Q
39 ;
40 ;
41 ;
42EN0 ;---Main entry point
43 ;
44 D DPOV4("BEGIN")
45 Q
46 ;
47 ;
48DIS ;----DISPLAY
49 ;--NOT CURRENTLY USED BUT IS HERE IF IT NEEDS TO BE REINSTATED
50 Q
51 I $D(PXBPMT("POV",$P($P(ENTRY,"^",1),"*"))) W:PXBCNT>11 IORVON W ?37," --Clinic Associated--",IORVOFF
52 Q
53 ;
54 ;
55DPOV4(SIGN) ;--Display the PROVIDER Data
56 ;
57 ;SIGN=
58 ; '+' add 10 to the starting point in ^TMP("PXBDPOV",$J)
59 ; '-' subtract 10 from the starting point but not less that 0
60 ; 'BEGIN' start at the beginning
61 ; 'SAME' start stays where it's at
62 ; '3'--any number set start to that number
63 ;
64 N PXBSTART
65 I SIGN="BEGIN" S ^TMP("PXBDPL",$J,"START")=0,PXBSTART=0
66 I SIGN="SAME" S PXBSTART=^TMP("PXBDPL",$J,"START")
67 I SIGN="+" S PXBSTART=($G(^TMP("PXBDPL",$J,"START"))+(10)) S:PXBSTART'<PXBCNTPL PXBSTART=(PXBCNTPL-(10)) S ^TMP("PXBDPL",$J,"START")=PXBSTART
68 I SIGN="-" S PXBSTART=$G(^TMP("PXBDPL",$J,"START"))-10,^TMP("PXBDPL",$J,"START")=PXBSTART I PXBSTART<0 S PXBSTART=0 S ^TMP("PXBDPL",$J,"START")=0
69 I +SIGN>0&(SIGN#10) S PXBSTART=$P((SIGN/10),".")*10 S:PXBSTART<10 PXBSTART=0 Q:^TMP("PXBDPL",$J,"START")=PXBSTART S ^TMP("PXBDPL",$J,"START")=PXBSTART
70 I +SIGN>0&'(SIGN#10) S PXBSTART=(($P((SIGN/10),".")*10)-10) S:PXBSTART<10 PXBSTART=0 Q:^TMP("PXBDPL",$J,"START")=PXBSTART S ^TMP("PXBDPL",$J,"START")=PXBSTART
71 ;
72 ;
73 I SIGN'="BEGIN" D LOC^PXBCC(3,0) W IOEDEOP
74 ;
75 ;
76 N ENTRY,J,HEAD
77 S HEAD="- - P A T I E N T P R O B L E M L I S T - -"
78 D LOC^PXBCC(3,10) W !,IOEDEOP,?(IOM-$L(HEAD))\2,IOINHI,HEAD,IOINLOW
79 D UNDON^PXBCC
80 W !,"No.",?4,"ICD",?13,"DESCRIPTION"
81 F I=1:1:40 W $C(32)
82 W IOEDEOP
83 D UNDOFF^PXBCC
84 ;
85 ;
86 S J=PXBSTART F S J=$O(PXBSAMPL(J)) Q:J="" Q:J=(PXBSTART+(11)) D
87 .S ENTRY=$G(PXBSAMPL(J)) I $D(PXBNPOV($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
88 .W !,J,?4,$J($P($P(ENTRY,"^",1),".",1),4),".",$P($P(ENTRY,"^",1),".",2),?13,$E($P(ENTRY,"^",2),1,30)
89 .D DIS
90 Q
91 ;
Note: See TracBrowser for help on using the repository browser.