PXCADXP1 ;ISL/dee & LEA/Chylton,SCK - 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,194,199**;Aug 12, 1996;Build 51
Q
;
PART1 ;
N PXCACLEX,PXDXDATE
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)
S PXDXDATE=$$CSDATE^PXDXUTL($G(PXCAVSIT))
I PXCAITEM>0 D
. S PXCADIQ1=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
. I $P(PXCADIQ1,U,1)'>0 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="Diagnosis Code pointer results in a '"_$P(PXCADIQ1,U,2)_"' error.^"_PXCAITEM
. E I $P(PXCADIQ1,U,10)'=1 S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="Diagnosis 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)="Diagnosis 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 without 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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCADXP1 3519 printed Dec 13, 2024@02:27:29 Page 2
PXCADXP1 ;ISL/dee & LEA/Chylton,SCK - 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,194,199**;Aug 12, 1996;Build 51
+2 QUIT
+3 ;
PART1 ;
+1 NEW PXCACLEX,PXDXDATE
+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 SET PXDXDATE=$$CSDATE^PXDXUTL($GET(PXCAVSIT))
+13 IF PXCAITEM>0
Begin DoDot:1
+14 SET PXCADIQ1=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
+15 IF $PIECE(PXCADIQ1,U,1)'>0
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="Diagnosis Code pointer results in a '"_$PIECE(PXCADIQ1,U,2)_"' error.^"_PXCAITEM
+16 IF '$TEST
IF $PIECE(PXCADIQ1,U,10)'=1
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="Diagnosis Code is INACTIVE^"_PXCAITEM
End DoDot:1
+17 ;
+18 ;Diagnosis Specification Code
+19 SET PXCAITM2=$PIECE(PXCADXPL,"^",2)
+20 IF PXCAITM2'=""
Begin DoDot:1
+21 SET PXCADIAG=1
+22 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
+23 IF '$TEST
IF PXCAITM2["P"
IF PXCAITEM>0
Begin DoDot:2
+24 IF 'PXCAPDX
SET PXCAPDX=PXCAITEM
+25 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
+26 IF '$TEST
Begin DoDot:3
+27 SET PXCA("WARNING","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis. This one is changed to Secondary^"_PXCAITM2
+28 SET $PIECE(PXCADXPL,"^",2)="S"
End DoDot:3
End DoDot:2
+29 IF PXCAITEM'>0
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,1)="Diagnosis Code is required for DIAGNOSIS^"_PXCAITEM
End DoDot:1
+30 ;
+31 ;Clinical Lexicon Term
+32 SET PXCAITEM=$PIECE(PXCADXPL,"^",3)
+33 IF PXCAITEM]""
Begin DoDot:1
+34 IF $DATA(^LEX(757.01))
Begin DoDot:2
+35 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
+36 IF '$TEST
SET PXCACLEX=PXCAITEM
End DoDot:2
+37 IF '$TEST
IF $DATA(^GMP(757.01))
Begin DoDot:2
+38 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
+39 IF '$TEST
SET PXCACLEX=PXCAITEM
End DoDot:2
+40 IF '$TEST
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,3)="Lexicon Utility is not installed^"_PXCAITEM
End DoDot:1
+41 ;
+42 ;Problem List IEN
+43 SET PXCAITEM=$PIECE(PXCADXPL,"^",4)
+44 ;Add to Problem List
+45 SET PXCAITM2=$PIECE(PXCADXPL,"^",5)
+46 IF PXCAITEM]""
Begin DoDot:1
+47 IF $GET(^AUPNPROB(PXCAITEM,0))=""
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Problem not in file 9000011^"_PXCAITEM
+48 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
+49 IF PXCAITM2=1
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,5)="Cannot ADD existing Problem to file 9000011^"_PXCAITM2
End DoDot:1
+50 IF '$TEST
IF PXCAPROB
IF PXCAITM2'=1
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,4)="Cannot update an existing Problem without an IEN to file 9000011^"_PXCAITEM
+51 IF '(PXCAITM2=1!(PXCAITM2=0)!(PXCAITM2=""))
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,5)="Add to Problem List flag bad^"_PXCAITM2
+52 IF PXCAITM2=1
IF PXCAPRV'>0
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,0)="Provider is required to add a new Problem^"_PXCAPRV
+53 ;
+54 QUIT
+55 ;
