PXBGPL.m

PXBGPL ;ISL/JVS - GATHER ACTIVE PROBLEM LIST ENTRIES ;5/12/97  11:58

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,28**;Aug 12, 1996

 ;

 ;

 ;

 W !,"This is not an entry point"

 ;

PL(PATIENT) ;--Entry point

 I '$L($T(ACTIVE^GMPLUTL)) Q

 ;

 ;--Set,kill and New

 N LINE,SUB,PXBC

 K PXBKYPL,PXBSAMPL,PXBSKYPL,PXBPMT

 ;

 D ACTIVE^GMPLUTL(PATIENT,.PXBPLA)

 ;

A ;

 Q:'$D(PXBPLA)

 S LINE=0 F  S LINE=$O(PXBPLA(LINE)) Q:LINE=""  D

 .Q:$P($G(PXBPLA(LINE,2)),"^",2)']""

 .S ^TMP("PXBSAMPL",$J,LINE)=$P(PXBPLA(LINE,2),"^",2)_"^"_$P(PXBPLA(LINE,1),"^",2)

 .S PXBPMT("PL",$P(PXBPLA(LINE,2),"^",2)_" "_$P(PXBPLA(LINE,1),"^",2))=""

 .S ^TMP("PXBKYPL",$J,$P(PXBPLA(LINE,2),"^",2),LINE)=$P(PXBPLA(LINE,2),"^",2)_"^"_$P(PXBPLA(LINE,1),"^",2)

 .;S PXBSKYPL(LINE,+PXBPLA(LINE,0))=""

 .K PXBPLA(LINE)

B ;

 S PXBCNTPL=+PXBPLA(0)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXBGPL   830     printed  Apr 09, 2024@21:29:03                                                                                                                                                                                                       Page 2

PXBGPL    ;ISL/JVS - GATHER ACTIVE PROBLEM LIST ENTRIES ;5/12/97  11:58

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,28**;Aug 12, 1996

 +2       ;

 +3       ;

 +4       ;

 +5        WRITE !,"This is not an entry point"

 +6       ;

PL(PATIENT) ;--Entry point

 +1        IF '$LENGTH($TEXT(ACTIVE^GMPLUTL))

               QUIT 

 +2       ;

 +3       ;--Set,kill and New

 +4        NEW LINE,SUB,PXBC

 +5        KILL PXBKYPL,PXBSAMPL,PXBSKYPL,PXBPMT

 +6       ;

 +7        DO ACTIVE^GMPLUTL(PATIENT,.PXBPLA)

 +8       ;

A         ;

 +1        if '$DATA(PXBPLA)

               QUIT 

 +2        SET LINE=0

           FOR 

               SET LINE=$ORDER(PXBPLA(LINE))

               if LINE=""

                   QUIT 

               Begin DoDot:1

 +3                if $PIECE($GET(PXBPLA(LINE,2)),"^",2)']""

                       QUIT 

 +4                SET ^TMP("PXBSAMPL",$JOB,LINE)=$PIECE(PXBPLA(LINE,2),"^",2)_"^"_$PIECE(PXBPLA(LINE,1),"^",2)

 +5                SET PXBPMT("PL",$PIECE(PXBPLA(LINE,2),"^",2)_" "_$PIECE(PXBPLA(LINE,1),"^",2))=""

 +6                SET ^TMP("PXBKYPL",$JOB,$PIECE(PXBPLA(LINE,2),"^",2),LINE)=$PIECE(PXBPLA(LINE,2),"^",2)_"^"_$PIECE(PXBPLA(LINE,1),"^",2)

 +7       ;S PXBSKYPL(LINE,+PXBPLA(LINE,0))=""

 +8                KILL PXBPLA(LINE)

               End DoDot:1

B         ;

 +1        SET PXBCNTPL=+PXBPLA(0)

 +2        QUIT