- 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 Feb 18, 2025@23:52:54 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