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 ---[H[J[2J[HPXBGPL 830 printed Oct 16, 2024@18:27:19 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
