PXBDPL ;ISL/JVS - DISPLAY PROBLEM LIST ENTRIES ;5/21/96 11:30
;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
;
;
EN1 ;-FIRST Entry Point
N OK,RDATA,QUIT
N PXBSAMPL,PXBKYPL,PXBSKYPL
D PL^PXBGPL(PATIENT),EN0
ENA ;--
S QUIT=0
I PXBCNTPL'>10 G ENB
I PXBCNTPL>10 D
.D LOC^PXBCC(15,1)
.W !!,"Enter a '+' for NEXT page or '-' for PREVIOUS page."
.W !,"Select a DIAGNOSIS from the Active PROBLEM lIST: "
.R OK:DTIME
.I OK["?" D WIN17^PXBCC(PXBCNTPL),HELP^PXBUTL0("PL1")
.I OK]"","+-"[OK D DPOV4(OK)
.I OK]"","+-"'[OK,OK?.N,OK>0,OK<(PXBCNTPL+(1)) S RDATA=PXBSAMPL(OK) S QUIT=1
.I "^"[OK S QUIT=1 S DATA="" Q
I QUIT=1 G ENXIT
G ENA
Q
ENB ;---
I PXBCNTPL'>10 D
.W !!,"Select a DIAGNOSIS from the Active PROBLEM lIST: "
.R OK:DTIME
.I OK["?" D WIN17^PXBCC(PXBCNTPL),HELP^PXBUTL0("PL11")
.I OK]"",OK?.N,OK>0,OK<(PXBCNTPL+(1)) S RDATA=PXBSAMPL(OK) S QUIT=1
.I "^"[OK S QUIT=1 S DATA="" Q
I QUIT=1 G ENXIT
G ENB
ENXIT ;EXIT
K PXBPLA
I $D(RDATA),$G(RDATA) S (DATA,EDATA)=$P(RDATA,"^",1)
;--Go Back to the POV list
D LOC^PXBCC(3,1) W IOEDEOP D POV^PXBGPOV(PXBVST),EN0^PXBDPOV W !!
Q
;
;
;
EN0 ;---Main entry point
;
D DPOV4("BEGIN")
Q
;
;
DIS ;----DISPLAY
;--NOT CURRENTLY USED BUT IS HERE IF IT NEEDS TO BE REINSTATED
Q
I $D(PXBPMT("POV",$P($P(ENTRY,"^",1),"*"))) W:PXBCNT>11 IORVON W ?37," --Clinic Associated--",IORVOFF
Q
;
;
DPOV4(SIGN) ;--Display the PROVIDER 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("PXBDPL",$J,"START")=0,PXBSTART=0
I SIGN="SAME" S PXBSTART=^TMP("PXBDPL",$J,"START")
I SIGN="+" S PXBSTART=($G(^TMP("PXBDPL",$J,"START"))+(10)) S:PXBSTART'<PXBCNTPL PXBSTART=(PXBCNTPL-(10)) S ^TMP("PXBDPL",$J,"START")=PXBSTART
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
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
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
;
;
I SIGN'="BEGIN" D LOC^PXBCC(3,0) W IOEDEOP
;
;
N ENTRY,J,HEAD
S HEAD="- - P A T I E N T P R O B L E M L I S T - -"
D LOC^PXBCC(3,10) W !,IOEDEOP,?(IOM-$L(HEAD))\2,IOINHI,HEAD,IOINLOW
D UNDON^PXBCC
W !,"No.",?4,"ICD",?13,"DESCRIPTION"
F I=1:1:40 W $C(32)
W IOEDEOP
D UNDOFF^PXBCC
;
;
S J=PXBSTART F S J=$O(PXBSAMPL(J)) Q:J="" Q:J=(PXBSTART+(11)) D
.S ENTRY=$G(PXBSAMPL(J)) I $D(PXBNPOV($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
.W !,J,?4,$J($P($P(ENTRY,"^",1),".",1),4),".",$P($P(ENTRY,"^",1),".",2),?13,$E($P(ENTRY,"^",2),1,30)
.D DIS
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBDPL 3052 printed Dec 13, 2024@02:26:26 Page 2
PXBDPL ;ISL/JVS - DISPLAY PROBLEM LIST ENTRIES ;5/21/96 11:30
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
+2 ;
+3 ;
EN1 ;-FIRST Entry Point
+1 NEW OK,RDATA,QUIT
+2 NEW PXBSAMPL,PXBKYPL,PXBSKYPL
+3 DO PL^PXBGPL(PATIENT)
DO EN0
ENA ;--
+1 SET QUIT=0
+2 IF PXBCNTPL'>10
GOTO ENB
+3 IF PXBCNTPL>10
Begin DoDot:1
+4 DO LOC^PXBCC(15,1)
+5 WRITE !!,"Enter a '+' for NEXT page or '-' for PREVIOUS page."
+6 WRITE !,"Select a DIAGNOSIS from the Active PROBLEM lIST: "
+7 READ OK:DTIME
+8 IF OK["?"
DO WIN17^PXBCC(PXBCNTPL)
DO HELP^PXBUTL0("PL1")
+9 IF OK]""
IF "+-"[OK
DO DPOV4(OK)
+10 IF OK]""
IF "+-"'[OK
IF OK?.N
IF OK>0
IF OK<(PXBCNTPL+(1))
SET RDATA=PXBSAMPL(OK)
SET QUIT=1
+11 IF "^"[OK
SET QUIT=1
SET DATA=""
QUIT
End DoDot:1
+12 IF QUIT=1
GOTO ENXIT
+13 GOTO ENA
+14 QUIT
ENB ;---
+1 IF PXBCNTPL'>10
Begin DoDot:1
+2 WRITE !!,"Select a DIAGNOSIS from the Active PROBLEM lIST: "
+3 READ OK:DTIME
+4 IF OK["?"
DO WIN17^PXBCC(PXBCNTPL)
DO HELP^PXBUTL0("PL11")
+5 IF OK]""
IF OK?.N
IF OK>0
IF OK<(PXBCNTPL+(1))
SET RDATA=PXBSAMPL(OK)
SET QUIT=1
+6 IF "^"[OK
SET QUIT=1
SET DATA=""
QUIT
End DoDot:1
+7 IF QUIT=1
GOTO ENXIT
+8 GOTO ENB
ENXIT ;EXIT
+1 KILL PXBPLA
+2 IF $DATA(RDATA)
IF $GET(RDATA)
SET (DATA,EDATA)=$PIECE(RDATA,"^",1)
+3 ;--Go Back to the POV list
+4 DO LOC^PXBCC(3,1)
WRITE IOEDEOP
DO POV^PXBGPOV(PXBVST)
DO EN0^PXBDPOV
WRITE !!
+5 QUIT
+6 ;
+7 ;
+8 ;
EN0 ;---Main entry point
+1 ;
+2 DO DPOV4("BEGIN")
+3 QUIT
+4 ;
+5 ;
DIS ;----DISPLAY
+1 ;--NOT CURRENTLY USED BUT IS HERE IF IT NEEDS TO BE REINSTATED
+2 QUIT
+3 IF $DATA(PXBPMT("POV",$PIECE($PIECE(ENTRY,"^",1),"*")))
if PXBCNT>11
WRITE IORVON
WRITE ?37," --Clinic Associated--",IORVOFF
+4 QUIT
+5 ;
+6 ;
DPOV4(SIGN) ;--Display the PROVIDER 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("PXBDPL",$JOB,"START")=0
SET PXBSTART=0
+11 IF SIGN="SAME"
SET PXBSTART=^TMP("PXBDPL",$JOB,"START")
+12 IF SIGN="+"
SET PXBSTART=($GET(^TMP("PXBDPL",$JOB,"START"))+(10))
if PXBSTART'<PXBCNTPL
SET PXBSTART=(PXBCNTPL-(10))
SET ^TMP("PXBDPL",$JOB,"START")=PXBSTART
+13 IF SIGN="-"
SET PXBSTART=$GET(^TMP("PXBDPL",$JOB,"START"))-10
SET ^TMP("PXBDPL",$JOB,"START")=PXBSTART
IF PXBSTART<0
SET PXBSTART=0
SET ^TMP("PXBDPL",$JOB,"START")=0
+14 IF +SIGN>0&(SIGN#10)
SET PXBSTART=$PIECE((SIGN/10),".")*10
if PXBSTART<10
SET PXBSTART=0
if ^TMP("PXBDPL",$JOB,"START")=PXBSTART
QUIT
SET ^TMP("PXBDPL",$JOB,"START")=PXBSTART
+15 IF +SIGN>0&'(SIGN#10)
SET PXBSTART=(($PIECE((SIGN/10),".")*10)-10)
if PXBSTART<10
SET PXBSTART=0
if ^TMP("PXBDPL",$JOB,"START")=PXBSTART
QUIT
SET ^TMP("PXBDPL",$JOB,"START")=PXBSTART
+16 ;
+17 ;
+18 IF SIGN'="BEGIN"
DO LOC^PXBCC(3,0)
WRITE IOEDEOP
+19 ;
+20 ;
+21 NEW ENTRY,J,HEAD
+22 SET HEAD="- - P A T I E N T P R O B L E M L I S T - -"
+23 DO LOC^PXBCC(3,10)
WRITE !,IOEDEOP,?(IOM-$LENGTH(HEAD))\2,IOINHI,HEAD,IOINLOW
+24 DO UNDON^PXBCC
+25 WRITE !,"No.",?4,"ICD",?13,"DESCRIPTION"
+26 FOR I=1:1:40
WRITE $CHAR(32)
+27 WRITE IOEDEOP
+28 DO UNDOFF^PXBCC
+29 ;
+30 ;
+31 SET J=PXBSTART
FOR
SET J=$ORDER(PXBSAMPL(J))
if J=""
QUIT
if J=(PXBSTART+(11))
QUIT
Begin DoDot:1
+32 SET ENTRY=$GET(PXBSAMPL(J))
IF $DATA(PXBNPOV($PIECE(ENTRY,"^",1)))
SET $PIECE(ENTRY,"^",1)=$PIECE(ENTRY,"^",1)_"*"
+33 WRITE !,J,?4,$JUSTIFY($PIECE($PIECE(ENTRY,"^",1),".",1),4),".",$PIECE($PIECE(ENTRY,"^",1),".",2),?13,$EXTRACT($PIECE(ENTRY,"^",2),1,30)
+34 DO DIS
End DoDot:1
+35 QUIT
+36 ;
