Routine: PXBDPL

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

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 !!

EN0 ;---Main entry point

 D DPOV4("BEGIN")

DIS ;----DISPLAY

 ;--NOT CURRENTLY USED BUT IS HERE IF IT NEEDS TO BE REINSTATED

 I $D(PXBPMT("POV",$P($P(ENTRY,"^",1),"*"))) W:PXBCNT>11 IORVON W ?37," --Clinic Associated--",IORVOFF

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBDPL   3052     printed  Mar 13, 2025@21:31:09                                                                                                                                                                                                      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      ;

PXBDPL.m