| 1 | PXBGPOV ;ISL/JVS,ESW - GATHER POV (DIAGNOSIS) ;8/10/04 1:30pm
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,112,149,124**;Aug 12, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | POV(VISIT) ;--Gather the entries in the V POV file
|
|---|
| 5 | ;
|
|---|
| 6 | N IEN,QUANTITY,PROVIDER,SNARR,POV,GROUP,PXBC,POVI,I,PXCI
|
|---|
| 7 | N DIC,DR,DA,DIQ,PRIM,PROBLEM,PXBPLA,PXBPL,PKG,SOURC
|
|---|
| 8 | ;
|
|---|
| 9 | K ^TMP("PXBU",$J),POV,PXBKY,PXBSAM,PXBSKY,PXDIGNS,NOPLLIST
|
|---|
| 10 | K ^UTILITY("DIQ1",$J)
|
|---|
| 11 | S FPRI="",PROBLEM=""
|
|---|
| 12 | I $D(^AUPNVPOV("AD",VISIT)) D
|
|---|
| 13 | .S IEN=0 F S IEN=$O(^AUPNVPOV("AD",VISIT,IEN)) Q:IEN'>0 D
|
|---|
| 14 | ..S ^TMP("PXBU",$J,"POV",IEN)=""
|
|---|
| 15 | ;
|
|---|
| 16 | A ;--Set array with DIAGNOSIS codes
|
|---|
| 17 | ;
|
|---|
| 18 | D PL^PXBGPL(PATIENT)
|
|---|
| 19 | I $D(^TMP("PXBU",$J,"POV")) D
|
|---|
| 20 | .S IEN=0 F S IEN=$O(^TMP("PXBU",$J,"POV",IEN)) Q:IEN'>0 D
|
|---|
| 21 | ..S DIC=9000010.07,DR=".01;1204;.04;.12;.17;81202;81203;80001:80007",DA=IEN,DIQ(0)="IE" D EN^DIQ1
|
|---|
| 22 | ..S PROVIDER=$G(^UTILITY("DIQ1",$J,9000010.07,DA,"1204","E"))
|
|---|
| 23 | ..S LNARR=$G(^UTILITY("DIQ1",$J,9000010.07,DA,".04","E"))
|
|---|
| 24 | ..S POV=$G(^UTILITY("DIQ1",$J,9000010.07,DA,".01","E"))
|
|---|
| 25 | ..S PROBLEM="" S:$D(^TMP("PXBKYPL",$J,POV)) PROBLEM="YES"
|
|---|
| 26 | ..S POVI=$G(^UTILITY("DIQ1",$J,9000010.07,DA,".01","I"))
|
|---|
| 27 | ..S PRIM=$G(^UTILITY("DIQ1",$J,9000010.07,DA,".12","E"))
|
|---|
| 28 | ..S ORDER=$G(^UTILITY("DIQ1",$J,9000010.07,DA,".17","E"))
|
|---|
| 29 | ..S PKG=$G(^UTILITY("DIQ1",$J,9000010.07,DA,"81202","I"))
|
|---|
| 30 | ..I PKG']"" S PKG="NONE"
|
|---|
| 31 | ..S SOURC=$G(^UTILITY("DIQ1",$J,9000010.07,DA,"81203","I"))
|
|---|
| 32 | ..I SOURC']"" S SOURC="NONE"
|
|---|
| 33 | ..S SNARR=$P($$ICDDX^ICDCODE(POVI,$G(IDATE)),U,4)
|
|---|
| 34 | ..I $L(LNARR)'>30 S LNARR=$$DXNARR^PXUTL1(POVI,$G(IDATE))
|
|---|
| 35 | ..S FPRI=FPRI_$E(PRIM,1,3) ;--Creating flag for Primary prompt
|
|---|
| 36 | ..S GROUP=POV_"^"_PROVIDER_"^"_SNARR_"^"_PRIM_"^"_PROBLEM_"^"_LNARR_"^"_ORDER
|
|---|
| 37 | ..; 1 2 3 4 5 6 7
|
|---|
| 38 | ..I PRIM["PRI" S PXDIGNS("PRIMARY")=POV
|
|---|
| 39 | ..S ^TMP("PXBPOV",$J,POV,IEN)=GROUP
|
|---|
| 40 | ..S ^TMP("PXBGPOVMATCH",$J,POVI,IEN)=""
|
|---|
| 41 | ..I $P(GROUP,"^",5)'["YES" S NOPLLIST=1
|
|---|
| 42 | ..S GROUP=$G(^UTILITY("DIQ1",$J,9000010.07,IEN,80001,"I"))
|
|---|
| 43 | ..F I=2:1:7 S GROUP=GROUP_U_$G(^UTILITY("DIQ1",$J,9000010.07,IEN,80000+I,"I"))
|
|---|
| 44 | ..S PXCI(IEN)=GROUP,PXBREQ(POVI,"I")=GROUP
|
|---|
| 45 | ;
|
|---|
| 46 | B ;--Add line numbers
|
|---|
| 47 | ;
|
|---|
| 48 | I $D(^TMP("PXBPOV",$J)) D
|
|---|
| 49 | .S PXBC=0,POV="" F S POV=$O(^TMP("PXBPOV",$J,POV)) Q:POV="" Q:PXBC>40 D
|
|---|
| 50 | ..S IEN=0 F S IEN=$O(^TMP("PXBPOV",$J,POV,IEN)) Q:IEN="" S PXBC=PXBC+1 D
|
|---|
| 51 | ...S PXBKY(POV,PXBC)=$G(^TMP("PXBPOV",$J,POV,IEN)),PXBSAM(PXBC)=$G(^TMP("PXBPOV",$J,POV,IEN))
|
|---|
| 52 | ...S PXBSKY(PXBC,IEN)=""
|
|---|
| 53 | ...S PXBSAM(PXBC,"LNARR")=$P(PXBSAM(PXBC),U,6)
|
|---|
| 54 | ...S PXBSAM(PXBC,"I")=PXCI(IEN)
|
|---|
| 55 | FINISG ;--finish up some variables
|
|---|
| 56 | ;--FPRI=0 NO PRIMARY
|
|---|
| 57 | S:FPRI'["PRI" FPRI=0 S:FPRI["PRI" FPRI=1
|
|---|
| 58 | EXIT ;--KILL
|
|---|
| 59 | K ^TMP("PXBU",$J),^TMP("PXBKYPL",$J),^TMP("PXBSAMPL",$J),PXBSKYPL
|
|---|
| 60 | K ^TMP("PXBPOV",$J),^UTILITY("DIQ1",$J)
|
|---|
| 61 | S PXBCNT=+$G(PXBC)
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | XLATE(VST,DX) ;Translate DX into POV from VST
|
|---|
| 65 | Q:'$G(VST)!'$G(DX) "" Q:'$D(^AUPNVPOV("AD",VST)) ""
|
|---|
| 66 | S DX=+$$ICDDX^ICDCODE(DX,+$G(^AUPNVSIT(VST,0))) Q:DX<0 ""
|
|---|
| 67 | N IEN,ANS,VAL S (IEN,ANS,VAL)=""
|
|---|
| 68 | F Q:ANS D
|
|---|
| 69 | .S IEN=$O(^AUPNVPOV("AD",VST,IEN)) I 'IEN S ANS=1 Q
|
|---|
| 70 | .S VAL=$G(^AUPNVPOV(IEN,0)),ANS=($P(VAL,U)=DX)
|
|---|
| 71 | S ANS=IEN_U_DX_U_$P(VAL,U,12) S:IEN ANS=ANS_U_$G(^AUPNVPOV(IEN,800))
|
|---|
| 72 | Q ANS
|
|---|
| 73 | ;
|
|---|
