PXCAPOV ;ISL/dee & LEA/Chylton - Validates data from the PCE Device Interface into PCE's PXK format for POV ;3/20/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**24,27,33**;Aug 12, 1996
Q
; Variables
; PXCADIAG Copy of a Diagnosis node of the PXCA array
; PXCAPRV Pointer to the provider (200)
; PXCANUMB Count of the number if POVs
; PXCAINDX Count of the number of Diagnoses for one provider
;
DIAG(PXCA,PXCABULD,PXCAERRS) ;Validation routine for POV
N PXCADIAG,PXCAPRV,PXCANUMB,PXCAINDX
S PXCAPRV=""
S PXCANUMB=0
F S PXCAPRV=$O(PXCA("DIAGNOSIS",PXCAPRV)) Q:PXCAPRV']"" D
. I PXCAPRV>0 D
.. I '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
.. E I PXCABULD!PXCAERRS D ANOTHPRV^PXCAPRV(PXCAPRV)
. S PXCAINDX=0
. F S PXCAINDX=$O(PXCA("DIAGNOSIS",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
.. S PXCADIAG=$G(PXCA("DIAGNOSIS",PXCAPRV,PXCAINDX))
.. S PXCANUMB=PXCANUMB+1
.. I PXCADIAG="" S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,0)="DIAGNOSIS data missing" Q
.. N PXCAITEM,PXCAITM2,PXCAPNAR,PXCANARC,PXCACLEX
.. ;
.. S PXCAITEM=$P(PXCADIAG,"^",1)
.. D
... N DIC,DR,DA,DIQ,PXCADIQ1
... S DIC=80
... S DR=".01;102"
... S DA=$S(PXCAITEM'="":PXCAITEM,1:-1)
... S DIQ="PXCADIQ1("
... S DIQ(0)="I"
... D EN^DIQ1
... I $G(PXCADIQ1(80,DA,.01,"I"))="" S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="ICD9 Code not in file 80^"_PXCAITEM
... E I $G(PXCADIQ1(80,DA,102,"I")),PXCADIQ1(80,DA,102,"I")'>+PXCADT S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="ICD9 Code is INACTIVE^"_PXCAITEM
.. S PXCAITEM=$P(PXCADIAG,"^",2)
.. I '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="S")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="Diagnosis specification code must be P|S^"_PXCAITEM
.. E I PXCAITEM="P" D
... I 'PXCAPDX S PXCAPDX=$P(PXCADIAG,"^",1)
... E I $P($G(^PX(815,1,"DI")),"^",2) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis for this encounter^"_PXCAITEM
... E D
.... S PXCA("WARNING","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis. This one is changed to Secondary^"_PXCAITEM
.... S $P(PXCADIAG,"^",2)="S"
.. S PXCAITEM=$P(PXCADIAG,"^",3)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,3)="SC flag bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCADIAG,"^",4)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,4)="AO flag bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCADIAG,"^",5)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,5)="IR flag bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCADIAG,"^",6)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,6)="EC flag bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCADIAG,"^",7)
.. I PXCAITEM]"" D
... I $G(^AUPNPROB(PXCAITEM,0))="" S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,7)="Problem not in file 9000011^"_PXCAITEM
... E I PXCAPAT'=$P($G(^AUPNPROB(PXCAITEM,0)),"^",2) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,7)="Problem in file 9000011 is for a different Patient^"_PXCAITEM
.. ;
.. ;Clinical Lexicon Term
.. S PXCAITEM=$P(PXCADIAG,"^",10)
.. I PXCAITEM]"" D
... I $D(^LEX(757.01)) D
.... I $D(^LEX(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Lexicon Utility term is not in file 757.01^"_PXCAITEM
.... E S PXCACLEX=PXCAITEM
... E I $D(^GMP(757.01)) D
.... I $D(^GMP(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM
.... E S PXCACLEX=PXCAITEM
... E S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Lexicon Utility is not installed^"_PXCAITEM
.. ;
.. D PART1^PXCAPOV1
.. ;
.. I PXCABULD&'$D(PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX))!PXCAERRS D POV^PXCADX(PXCADIAG,PXCANUMB,PXCAPRV,PXCAERRS)
Q
;
PXCAPOV ;ISL/dee & LEA/Chylton - Validates data from the PCE Device Interface into PCE's PXK format for POV ;3/20/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,27,33**;Aug 12, 1996
+2 QUIT
+3 ; Variables
+4 ; PXCADIAG Copy of a Diagnosis node of the PXCA array
+5 ; PXCAPRV Pointer to the provider (200)
+6 ; PXCANUMB Count of the number if POVs
+7 ; PXCAINDX Count of the number of Diagnoses for one provider
+8 ;
DIAG(PXCA,PXCABULD,PXCAERRS) ;Validation routine for POV
+1 NEW PXCADIAG,PXCAPRV,PXCANUMB,PXCAINDX
+2 SET PXCAPRV=""
+3 SET PXCANUMB=0
+4 FOR
SET PXCAPRV=$ORDER(PXCA("DIAGNOSIS",PXCAPRV))
IF PXCAPRV']""
QUIT
Begin DoDot:1
+5 IF PXCAPRV>0
Begin DoDot:2
+6 IF '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT)
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
+7 IF '$TEST
IF PXCABULD!PXCAERRS
DO ANOTHPRV^PXCAPRV(PXCAPRV)
End DoDot:2
+8 SET PXCAINDX=0
+9 FOR
SET PXCAINDX=$ORDER(PXCA("DIAGNOSIS",PXCAPRV,PXCAINDX))
IF PXCAINDX']""
QUIT
Begin DoDot:2
+10 SET PXCADIAG=$GET(PXCA("DIAGNOSIS",PXCAPRV,PXCAINDX))
+11 SET PXCANUMB=PXCANUMB+1
+12 IF PXCADIAG=""
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,0)="DIAGNOSIS data missing"
QUIT
+13 NEW PXCAITEM,PXCAITM2,PXCAPNAR,PXCANARC,PXCACLEX
+14 ;
+15 SET PXCAITEM=$PIECE(PXCADIAG,"^",1)
+16 Begin DoDot:3
+17 NEW DIC,DR,DA,DIQ,PXCADIQ1
+18 SET DIC=80
+19 SET DR=".01;102"
+20 SET DA=$SELECT(PXCAITEM'="":PXCAITEM,1:-1)
+21 SET DIQ="PXCADIQ1("
+22 SET DIQ(0)="I"
+23 DO EN^DIQ1
+24 IF $GET(PXCADIQ1(80,DA,.01,"I"))=""
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="ICD9 Code not in file 80^"_PXCAITEM
+25 IF '$TEST
IF $GET(PXCADIQ1(80,DA,102,"I"))
IF PXCADIQ1(80,DA,102,"I")'>+PXCADT
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="ICD9 Code is INACTIVE^"_PXCAITEM
End DoDot:3
+26 SET PXCAITEM=$PIECE(PXCADIAG,"^",2)
+27 IF '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="S"))
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="Diagnosis specification code must be P|S^"_PXCAITEM
+28 IF '$TEST
IF PXCAITEM="P"
Begin DoDot:3
+29 IF 'PXCAPDX
SET PXCAPDX=$PIECE(PXCADIAG,"^",1)
+30 IF '$TEST
IF $PIECE($GET(^PX(815,1,"DI")),"^",2)
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis for this encounter^"_PXCAITEM
+31 IF '$TEST
Begin DoDot:4
+32 SET PXCA("WARNING","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis. This one is changed to Secondary^"_PXCAITEM
+33 SET $PIECE(PXCADIAG,"^",2)="S"
End DoDot:4
End DoDot:3
+34 SET PXCAITEM=$PIECE(PXCADIAG,"^",3)
+35 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,3)="SC flag bad^"_PXCAITEM
+36 SET PXCAITEM=$PIECE(PXCADIAG,"^",4)
+37 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,4)="AO flag bad^"_PXCAITEM
+38 SET PXCAITEM=$PIECE(PXCADIAG,"^",5)
+39 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,5)="IR flag bad^"_PXCAITEM
+40 SET PXCAITEM=$PIECE(PXCADIAG,"^",6)
+41 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,6)="EC flag bad^"_PXCAITEM
+42 SET PXCAITEM=$PIECE(PXCADIAG,"^",7)
+43 IF PXCAITEM]""
Begin DoDot:3
+44 IF $GET(^AUPNPROB(PXCAITEM,0))=""
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,7)="Problem not in file 9000011^"_PXCAITEM
+45 IF '$TEST
IF PXCAPAT'=$PIECE($GET(^AUPNPROB(PXCAITEM,0)),"^",2)
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,7)="Problem in file 9000011 is for a different Patient^"_PXCAITEM
End DoDot:3
+46 ;
+47 ;Clinical Lexicon Term
+48 SET PXCAITEM=$PIECE(PXCADIAG,"^",10)
+49 IF PXCAITEM]""
Begin DoDot:3
+50 IF $DATA(^LEX(757.01))
Begin DoDot:4
+51 IF $DATA(^LEX(757.01,PXCAITEM,0))#2'=1
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Lexicon Utility term is not in file 757.01^"_PXCAITEM
+52 IF '$TEST
SET PXCACLEX=PXCAITEM
End DoDot:4
+53 IF '$TEST
IF $DATA(^GMP(757.01))
Begin DoDot:4
+54 IF $DATA(^GMP(757.01,PXCAITEM,0))#2'=1
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM
+55 IF '$TEST
SET PXCACLEX=PXCAITEM
End DoDot:4
+56 IF '$TEST
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Lexicon Utility is not installed^"_PXCAITEM
End DoDot:3
+57 ;
+58 DO PART1^PXCAPOV1
+59 ;
+60 IF PXCABULD&'$DATA(PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX))!PXCAERRS
DO POV^PXCADX(PXCADIAG,PXCANUMB,PXCAPRV,PXCAERRS)
End DoDot:2
End DoDot:1
+61 QUIT
+62 ;
