PXCADXP1 ;ISL/dee & LEA/Chylton - Validates & Translates data from the PCE Device Interface into a call to V POV & update Problem List ;3/20/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**24,33**;Aug 12, 1996
Q
;
PART1 ;
N PXCACLEX
S (PXCADIAG,PXCAPROB)=0
I "^^^"'[$P(PXCADXPL,"^",5,8) S PXCAPROB=1
;Note
S PXCAITEM=$P($G(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,"NOTE")),"^",1),PXCAITM2=$L(PXCAITEM)
I PXCAITEM]"" D
. I PXCAITM2<3!(PXCAITM2>60) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,"NOTE",1)="PROBLEM Note must be 1-60 Characters^"_PXCAITEM
. S PXCAPROB=1
;
;Diagnosis Code
S PXCAITEM=$P(PXCADXPL,"^",1)
I PXCAITEM>0 D
. N DIC,DR,DA,DIQ,PXCADIQ1
. S DIC=80
. S DR=".01;102"
. S DA=PXCAITEM
. S DIQ="PXCADIQ1("
. S DIQ(0)="I"
. D EN^DIQ1
. I $G(PXCADIQ1(80,DA,.01,"I"))="" S PXCA("ERROR","DIAGNOSIS/PROBLEM",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/PROBLEM",PXCAPRV,PXCAINDX,1)="ICD9 Code is INACTIVE^"_PXCAITEM
;
;Diagnosis Specification Code
S PXCAITM2=$P(PXCADXPL,"^",2)
I PXCAITM2'="" D
. S PXCADIAG=1
. I '((PXCAITM2="P")!(PXCAITM2="S")!(PXCAITM2="PS")!(PXCAITM2="SP")) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,2)="Diagnosis specification code must be P|S^"_PXCAITM2
. E I PXCAITM2["P",PXCAITEM>0 D
.. I 'PXCAPDX S PXCAPDX=PXCAITEM
.. E I $P($G(^PX(815,1,"DI")),"^",2) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis for this encounter^"_PXCAITM2
.. E D
... S PXCA("WARNING","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis. This one is changed to Secondary^"_PXCAITM2
... S $P(PXCADXPL,"^",2)="S"
. I PXCAITEM'>0 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="ICD9 Code is required for DIAGNOSIS^"_PXCAITEM
;
;Clinical Lexicon Term
S PXCAITEM=$P(PXCADXPL,"^",3)
I PXCAITEM]"" D
. I $D(^LEX(757.01)) D
.. I $D(^LEX(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,3)="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/PROBLEM",PXCAPRV,PXCAINDX,3)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM
.. E S PXCACLEX=PXCAITEM
. E S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,3)="Lexicon Utility is not installed^"_PXCAITEM
;
;Problem List IEN
S PXCAITEM=$P(PXCADXPL,"^",4)
;Add to Problem List
S PXCAITM2=$P(PXCADXPL,"^",5)
I PXCAITEM]"" D
. I $G(^AUPNPROB(PXCAITEM,0))="" S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Problem not in file 9000011^"_PXCAITEM
. E I PXCAPAT'=$P($G(^AUPNPROB(PXCAITEM,0)),"^",2) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Problem in file 9000011 is for a different Patient^"_PXCAITEM
. I PXCAITM2=1 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,5)="Cannot ADD existing Problem to file 9000011^"_PXCAITM2
E I PXCAPROB,PXCAITM2'=1 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Cannot update an existing Problem with out an IEN to file 9000011^"_PXCAITEM
I '(PXCAITM2=1!(PXCAITM2=0)!(PXCAITM2="")) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,5)="Add to Problem List flag bad^"_PXCAITM2
I PXCAITM2=1,PXCAPRV'>0 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,0)="Provider is required to add a new Problem^"_PXCAPRV
;
Q
;
PXCADXP1 ;ISL/dee & LEA/Chylton - Validates & Translates data from the PCE Device Interface into a call to V POV & update Problem List ;3/20/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,33**;Aug 12, 1996
+2 QUIT
+3 ;
PART1 ;
+1 NEW PXCACLEX
+2 SET (PXCADIAG,PXCAPROB)=0
+3 IF "^^^"'[$PIECE(PXCADXPL,"^",5,8)
SET PXCAPROB=1
+4 ;Note
+5 SET PXCAITEM=$PIECE($GET(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,"NOTE")),"^",1)
SET PXCAITM2=$LENGTH(PXCAITEM)
+6 IF PXCAITEM]""
Begin DoDot:1
+7 IF PXCAITM2<3!(PXCAITM2>60)
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,"NOTE",1)="PROBLEM Note must be 1-60 Characters^"_PXCAITEM
+8 SET PXCAPROB=1
End DoDot:1
+9 ;
+10 ;Diagnosis Code
+11 SET PXCAITEM=$PIECE(PXCADXPL,"^",1)
+12 IF PXCAITEM>0
Begin DoDot:1
+13 NEW DIC,DR,DA,DIQ,PXCADIQ1
+14 SET DIC=80
+15 SET DR=".01;102"
+16 SET DA=PXCAITEM
+17 SET DIQ="PXCADIQ1("
+18 SET DIQ(0)="I"
+19 DO EN^DIQ1
+20 IF $GET(PXCADIQ1(80,DA,.01,"I"))=""
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="ICD9 Code not in file 80^"_PXCAITEM
+21 IF '$TEST
IF $GET(PXCADIQ1(80,DA,102,"I"))
IF PXCADIQ1(80,DA,102,"I")'>+PXCADT
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="ICD9 Code is INACTIVE^"_PXCAITEM
End DoDot:1
+22 ;
+23 ;Diagnosis Specification Code
+24 SET PXCAITM2=$PIECE(PXCADXPL,"^",2)
+25 IF PXCAITM2'=""
Begin DoDot:1
+26 SET PXCADIAG=1
+27 IF '((PXCAITM2="P")!(PXCAITM2="S")!(PXCAITM2="PS")!(PXCAITM2="SP"))
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,2)="Diagnosis specification code must be P|S^"_PXCAITM2
+28 IF '$TEST
IF PXCAITM2["P"
IF PXCAITEM>0
Begin DoDot:2
+29 IF 'PXCAPDX
SET PXCAPDX=PXCAITEM
+30 IF '$TEST
IF $PIECE($GET(^PX(815,1,"DI")),"^",2)
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis for this encounter^"_PXCAITM2
+31 IF '$TEST
Begin DoDot:3
+32 SET PXCA("WARNING","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis. This one is changed to Secondary^"_PXCAITM2
+33 SET $PIECE(PXCADXPL,"^",2)="S"
End DoDot:3
End DoDot:2
+34 IF PXCAITEM'>0
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="ICD9 Code is required for DIAGNOSIS^"_PXCAITEM
End DoDot:1
+35 ;
+36 ;Clinical Lexicon Term
+37 SET PXCAITEM=$PIECE(PXCADXPL,"^",3)
+38 IF PXCAITEM]""
Begin DoDot:1
+39 IF $DATA(^LEX(757.01))
Begin DoDot:2
+40 IF $DATA(^LEX(757.01,PXCAITEM,0))#2'=1
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,3)="Lexicon Utility term is not in file 757.01^"_PXCAITEM
+41 IF '$TEST
SET PXCACLEX=PXCAITEM
End DoDot:2
+42 IF '$TEST
IF $DATA(^GMP(757.01))
Begin DoDot:2
+43 IF $DATA(^GMP(757.01,PXCAITEM,0))#2'=1
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,3)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM
+44 IF '$TEST
SET PXCACLEX=PXCAITEM
End DoDot:2
+45 IF '$TEST
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,3)="Lexicon Utility is not installed^"_PXCAITEM
End DoDot:1
+46 ;
+47 ;Problem List IEN
+48 SET PXCAITEM=$PIECE(PXCADXPL,"^",4)
+49 ;Add to Problem List
+50 SET PXCAITM2=$PIECE(PXCADXPL,"^",5)
+51 IF PXCAITEM]""
Begin DoDot:1
+52 IF $GET(^AUPNPROB(PXCAITEM,0))=""
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Problem not in file 9000011^"_PXCAITEM
+53 IF '$TEST
IF PXCAPAT'=$PIECE($GET(^AUPNPROB(PXCAITEM,0)),"^",2)
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Problem in file 9000011 is for a different Patient^"_PXCAITEM
+54 IF PXCAITM2=1
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,5)="Cannot ADD existing Problem to file 9000011^"_PXCAITM2
End DoDot:1
+55 IF '$TEST
IF PXCAPROB
IF PXCAITM2'=1
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Cannot update an existing Problem with out an IEN to file 9000011^"_PXCAITEM
+56 IF '(PXCAITM2=1!(PXCAITM2=0)!(PXCAITM2=""))
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,5)="Add to Problem List flag bad^"_PXCAITM2
+57 IF PXCAITM2=1
IF PXCAPRV'>0
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,0)="Provider is required to add a new Problem^"_PXCAPRV
+58 ;
+59 QUIT
+60 ;
