PXBGPOV ;ISL/JVS,ESW - GATHER POV (DIAGNOSIS) ; 12/2/02 6:22pm
;;1.0;PCE PATIENT CARE ENCOUNTER;**11,112**;Aug 12, 1996
;
POV(VISIT) ;--Gather the entries in the V POV file
;
N IEN,QUANTITY,PROVIDER,SNARR,POV,GROUP,PXBC,POVI
N DIC,DR,DA,DIQ,PRIM,PROBLEM,PXBPLA,PXBPL,PKG,SOURC
;
K ^TMP("PXBU",$J),POV,PXBKY,PXBSAM,PXBSKY,PXDIGNS,NOPLLIST
K ^UTILITY("DIQ1",$J)
S FPRI="",PROBLEM=""
I $D(^AUPNVPOV("AD",VISIT)) D
.S IEN=0 F S IEN=$O(^AUPNVPOV("AD",VISIT,IEN)) Q:IEN'>0 D
..S ^TMP("PXBU",$J,"POV",IEN)=""
;
A ;--Set array with DIAGNOSIS codes
;
D PL^PXBGPL(PATIENT)
I $D(^TMP("PXBU",$J,"POV")) D
.S IEN=0 F S IEN=$O(^TMP("PXBU",$J,"POV",IEN)) Q:IEN'>0 D
..S DIC=9000010.07,DR=".01;1204;.04;.12;81202;81203",DA=IEN,DIQ(0)="IE" D EN^DIQ1
..S PROVIDER=$G(^UTILITY("DIQ1",$J,9000010.07,DA,"1204","E"))
..S LNARR=$G(^UTILITY("DIQ1",$J,9000010.07,DA,".04","E"))
..S POV=$G(^UTILITY("DIQ1",$J,9000010.07,DA,".01","E"))
..S PROBLEM="" S:$D(^TMP("PXBKYPL",$J,POV)) PROBLEM="YES"
..S POVI=$G(^UTILITY("DIQ1",$J,9000010.07,DA,".01","I"))
..S PRIM=$G(^UTILITY("DIQ1",$J,9000010.07,DA,".12","E"))
..S PKG=$G(^UTILITY("DIQ1",$J,9000010.07,DA,"81202","I"))
..I PKG']"" S PKG="NONE"
..S SOURC=$G(^UTILITY("DIQ1",$J,9000010.07,DA,"81203","I"))
..I SOURC']"" S SOURC="NONE"
..S SNARR=$$EXTTEXT^PXUTL1(POVI,1,80,3)
..I $L(LNARR)'>30 S LNARR=$$EXTTEXT^PXUTL1(POVI,1,80,10)
..S FPRI=FPRI_$E(PRIM,1,3) ;--Creating flag for Promary prompt
..S GROUP=POV_"^"_PROVIDER_"^"_SNARR_"^"_PRIM_"^"_PROBLEM
..; 1 2 3 4 5
..I PRIM["PRI" S PXDIGNS("PRIMARY")=POV
..S ^TMP("PXBPOV",$J,POV,IEN)=GROUP
..S ^TMP("PXBGPOVMATCH",$J,POVI,IEN)=""
..I $P(GROUP,"^",5)'["YES" S NOPLLIST=1
;
B ;--Add line numbers
;
I $D(^TMP("PXBPOV",$J)) D
.S PXBC=0,POV="" F S POV=$O(^TMP("PXBPOV",$J,POV)) Q:POV="" Q:PXBC>40 D
..S IEN=0 F S IEN=$O(^TMP("PXBPOV",$J,POV,IEN)) Q:IEN="" S PXBC=PXBC+1 D
...S PXBKY(POV,PXBC)=$G(^TMP("PXBPOV",$J,POV,IEN)),PXBSAM(PXBC)=$G(^TMP("PXBPOV",$J,POV,IEN))
...S PXBSKY(PXBC,IEN)=""
...S PXBSAM(PXBC,"LNARR")=LNARR
FINISG ;--finish up some variables
;--FPRI=0 NO PRIMARY
S:FPRI'["PRI" FPRI=0 S:FPRI["PRI" FPRI=1
EXIT ;--KILL
K ^TMP("PXBU",$J),^TMP("PXBKYPL",$J),^TMP("PXBSAMPL",$J),PXBSKYPL
K ^TMP("PXBPOV",$J)
K ^UTILITY("DIQ1",$J)
S PXBCNT=+$G(PXBC)
Q
;
PXBGPOV ;ISL/JVS,ESW - GATHER POV (DIAGNOSIS) ; 12/2/02 6:22pm
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,112**;Aug 12, 1996
+2 ;
POV(VISIT) ;--Gather the entries in the V POV file
+1 ;
+2 NEW IEN,QUANTITY,PROVIDER,SNARR,POV,GROUP,PXBC,POVI
+3 NEW DIC,DR,DA,DIQ,PRIM,PROBLEM,PXBPLA,PXBPL,PKG,SOURC
+4 ;
+5 KILL ^TMP("PXBU",$JOB),POV,PXBKY,PXBSAM,PXBSKY,PXDIGNS,NOPLLIST
+6 KILL ^UTILITY("DIQ1",$JOB)
+7 SET FPRI=""
SET PROBLEM=""
+8 IF $DATA(^AUPNVPOV("AD",VISIT))
Begin DoDot:1
+9 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVPOV("AD",VISIT,IEN))
IF IEN'>0
QUIT
Begin DoDot:2
+10 SET ^TMP("PXBU",$JOB,"POV",IEN)=""
End DoDot:2
End DoDot:1
+11 ;
A ;--Set array with DIAGNOSIS codes
+1 ;
+2 DO PL^PXBGPL(PATIENT)
+3 IF $DATA(^TMP("PXBU",$JOB,"POV"))
Begin DoDot:1
+4 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXBU",$JOB,"POV",IEN))
IF IEN'>0
QUIT
Begin DoDot:2
+5 SET DIC=9000010.07
SET DR=".01;1204;.04;.12;81202;81203"
SET DA=IEN
SET DIQ(0)="IE"
DO EN^DIQ1
+6 SET PROVIDER=$GET(^UTILITY("DIQ1",$JOB,9000010.07,DA,"1204","E"))
+7 SET LNARR=$GET(^UTILITY("DIQ1",$JOB,9000010.07,DA,".04","E"))
+8 SET POV=$GET(^UTILITY("DIQ1",$JOB,9000010.07,DA,".01","E"))
+9 SET PROBLEM=""
IF $DATA(^TMP("PXBKYPL",$JOB,POV))
SET PROBLEM="YES"
+10 SET POVI=$GET(^UTILITY("DIQ1",$JOB,9000010.07,DA,".01","I"))
+11 SET PRIM=$GET(^UTILITY("DIQ1",$JOB,9000010.07,DA,".12","E"))
+12 SET PKG=$GET(^UTILITY("DIQ1",$JOB,9000010.07,DA,"81202","I"))
+13 IF PKG']""
SET PKG="NONE"
+14 SET SOURC=$GET(^UTILITY("DIQ1",$JOB,9000010.07,DA,"81203","I"))
+15 IF SOURC']""
SET SOURC="NONE"
+16 SET SNARR=$$EXTTEXT^PXUTL1(POVI,1,80,3)
+17 IF $LENGTH(LNARR)'>30
SET LNARR=$$EXTTEXT^PXUTL1(POVI,1,80,10)
+18 ;--Creating flag for Promary prompt
SET FPRI=FPRI_$EXTRACT(PRIM,1,3)
+19 SET GROUP=POV_"^"_PROVIDER_"^"_SNARR_"^"_PRIM_"^"_PROBLEM
+20 ; 1 2 3 4 5
+21 IF PRIM["PRI"
SET PXDIGNS("PRIMARY")=POV
+22 SET ^TMP("PXBPOV",$JOB,POV,IEN)=GROUP
+23 SET ^TMP("PXBGPOVMATCH",$JOB,POVI,IEN)=""
+24 IF $PIECE(GROUP,"^",5)'["YES"
SET NOPLLIST=1
End DoDot:2
End DoDot:1
+25 ;
B ;--Add line numbers
+1 ;
+2 IF $DATA(^TMP("PXBPOV",$JOB))
Begin DoDot:1
+3 SET PXBC=0
SET POV=""
FOR
SET POV=$ORDER(^TMP("PXBPOV",$JOB,POV))
IF POV=""
QUIT
IF PXBC>40
QUIT
Begin DoDot:2
+4 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXBPOV",$JOB,POV,IEN))
IF IEN=""
QUIT
SET PXBC=PXBC+1
Begin DoDot:3
+5 SET PXBKY(POV,PXBC)=$GET(^TMP("PXBPOV",$JOB,POV,IEN))
SET PXBSAM(PXBC)=$GET(^TMP("PXBPOV",$JOB,POV,IEN))
+6 SET PXBSKY(PXBC,IEN)=""
+7 SET PXBSAM(PXBC,"LNARR")=LNARR
End DoDot:3
End DoDot:2
End DoDot:1
FINISG ;--finish up some variables
+1 ;--FPRI=0 NO PRIMARY
+2 IF FPRI'["PRI"
SET FPRI=0
IF FPRI["PRI"
SET FPRI=1
EXIT ;--KILL
+1 KILL ^TMP("PXBU",$JOB),^TMP("PXBKYPL",$JOB),^TMP("PXBSAMPL",$JOB),PXBSKYPL
+2 KILL ^TMP("PXBPOV",$JOB)
+3 KILL ^UTILITY("DIQ1",$JOB)
+4 SET PXBCNT=+$GET(PXBC)
+5 QUIT
+6 ;
