PXCAPL ;ISL/dee & LEA/Chylton,SCK - Validates data from the PCE Device Interface into a call to update Problem List ;6/6/05
;;1.0;PCE PATIENT CARE ENCOUNTER;**24,27,115,130,168,194,199**;Aug 12, 1996;Build 51
Q
; PXCAPROB Copy of a Problem node of the PXCA array
; PXCAPRV Pointer to the provider (200)
; PXCAINDX Count of the number of problems for one provider
; PXCAPL The parameter array passed to Problem List
; PXCARES The result back from Problem List
; PXCANUMB Count of the total number of problems
;
;
PROBLEM(PXCA,PXCABULD,PXCAERRS) ;
Q:'$D(PXCA("PROBLEM"))
I '$D(^AUPNPROB)!($T(UPDATE^GMPLUTL)="") S PXCA("WARNING","PROBLEM",0,0,0)="Problem List Package is not installed" Q
N PXCAINDX,PXCAITEM,PXCAITM2,PXCAPROB,PXCAPRV,PXDXDATE
S PXDXDATE=$S($D(PXCAVSIT)=1:$$CSDATE^PXDXUTL(PXCAVSIT),1:PXCADT)
S PXCAPRV=""
F S PXCAPRV=$O(PXCA("PROBLEM",PXCAPRV)) Q:PXCAPRV']"" D
. I '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT) S PXCA("ERROR","PROBLEM",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("PROBLEM",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
.. S PXCAPROB=$G(PXCA("PROBLEM",PXCAPRV,PXCAINDX))
.. I PXCAPROB="" S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,0)="PROBLEM data missing" Q
.. S PXCAITEM=$P(PXCAPROB,U,1),PXCAITM2=$L(PXCAITEM)
.. I PXCAITEM]"",PXCAITM2<2!(PXCAITM2>80) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,1)="Problem Name must be 2-80 Characters^"_PXCAITEM
.. S PXCAITEM=$P(PXCAPROB,U,2)
.. I PXCAITEM]"",PXCAITEM>DT!(PXCAITEM<1800000)!($P(+PXCAITEM,".")'=PXCAITEM)!(PXCAITEM>+$P($P(PXCA("ENCOUNTER"),"^"),".")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="Problem Onset Date is bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCAPROB,U,3)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,3)="Problem Active flag bad^"_PXCAITEM
.. E I PXCAITEM="" S $P(PXCA("PROBLEM",PXCAPRV,PXCAINDX),U,3)=1
.. S PXCAITEM=$P(PXCAPROB,U,4)
.. I PXCAITEM]"",PXCAITEM>DT!(PXCAITEM<1800000)!($P(+PXCAITEM,".")'=PXCAITEM)!(PXCAITEM>+$P($P(PXCA("ENCOUNTER"),"^"),".")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="Problem Resolved Date is bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCAPROB,U,5)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,5)="SC flag bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCAPROB,U,6)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,6)="AO flag bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCAPROB,U,7)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="IR flag bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCAPROB,U,8)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,8)="EC flag bad^"_PXCAITEM
.. ;PX*1*115 - ADD MST & HNC
.. S PXCAITEM=$P(PXCAPROB,U,13)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,13)="MST flag bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCAPROB,U,14)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,14)="HNC flag bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCAPROB,U,15)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,14)="CV flag bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCAPROB,U,16)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,16)="PROJ 112/SHAD flag bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCAPROB,U,9)
.. I PXCAITEM>0 D
... S PXCADIQ1=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
... I $P(PXCADIQ1,U,1)'>0 S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="Diagnosis Code pointer results in a '"_$P(PXCADIQ1,U,2)_"' error message.^"_PXCAITEM
... E I $P(PXCADIQ1,U,10)'=1 S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="Diagnosis Code is INACTIVE^"_PXCAITEM
.. S PXCAITEM=$P(PXCAPROB,U,10)
.. I PXCAITEM]"" D
... I $G(^AUPNPROB(PXCAITEM,0))="" S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,10)="Problem not in file 9000011^"_PXCAITEM
... E I PXCAPAT'=$P($G(^AUPNPROB(PXCAITEM,0)),"^",2) S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,10)="Problem in file 9000011 is for a different Patient^"_PXCAITEM
.. E S PXCAITEM=$P(PXCAPROB,U,1) I PXCAITEM']"" S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,1)="Problem Name required for a new Problem List entry^"_PXCAITEM
.. S PXCAITEM=$P(PXCAPROB,U,11),PXCAITM2=$L(PXCAITEM)
.. I PXCAITM2>60 S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,11)="PROBLEM comment must be 1-60 Characters^"_PXCAITEM
.. ;
.. ;Clinical Lexicon Term
.. S PXCAITEM=$P(PXCAPROB,"^",12)
.. I PXCAITEM]"" D
... I $D(^LEX(757.01)) D
.... I $D(^LEX(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="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","PROBLEM",PXCAPRV,PXCAINDX,12)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM
.... E S PXCACLEX=PXCAITEM
... E S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Lexicon Utility is not installed^"_PXCAITEM
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCAPL 5188 printed Nov 22, 2024@17:37:35 Page 2
PXCAPL ;ISL/dee & LEA/Chylton,SCK - Validates data from the PCE Device Interface into a call to update Problem List ;6/6/05
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,27,115,130,168,194,199**;Aug 12, 1996;Build 51
+2 QUIT
+3 ; PXCAPROB Copy of a Problem node of the PXCA array
+4 ; PXCAPRV Pointer to the provider (200)
+5 ; PXCAINDX Count of the number of problems for one provider
+6 ; PXCAPL The parameter array passed to Problem List
+7 ; PXCARES The result back from Problem List
+8 ; PXCANUMB Count of the total number of problems
+9 ;
+10 ;
PROBLEM(PXCA,PXCABULD,PXCAERRS) ;
+1 if '$DATA(PXCA("PROBLEM"))
QUIT
+2 IF '$DATA(^AUPNPROB)!($TEXT(UPDATE^GMPLUTL)="")
SET PXCA("WARNING","PROBLEM",0,0,0)="Problem List Package is not installed"
QUIT
+3 NEW PXCAINDX,PXCAITEM,PXCAITM2,PXCAPROB,PXCAPRV,PXDXDATE
+4 SET PXDXDATE=$SELECT($DATA(PXCAVSIT)=1:$$CSDATE^PXDXUTL(PXCAVSIT),1:PXCADT)
+5 SET PXCAPRV=""
+6 FOR
SET PXCAPRV=$ORDER(PXCA("PROBLEM",PXCAPRV))
if PXCAPRV']""
QUIT
Begin DoDot:1
+7 IF '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT)
SET PXCA("ERROR","PROBLEM",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
+8 IF '$TEST
IF PXCABULD!PXCAERRS
DO ANOTHPRV^PXCAPRV(PXCAPRV)
+9 SET PXCAINDX=0
+10 FOR
SET PXCAINDX=$ORDER(PXCA("PROBLEM",PXCAPRV,PXCAINDX))
if PXCAINDX']""
QUIT
Begin DoDot:2
+11 SET PXCAPROB=$GET(PXCA("PROBLEM",PXCAPRV,PXCAINDX))
+12 IF PXCAPROB=""
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,0)="PROBLEM data missing"
QUIT
+13 SET PXCAITEM=$PIECE(PXCAPROB,U,1)
SET PXCAITM2=$LENGTH(PXCAITEM)
+14 IF PXCAITEM]""
IF PXCAITM2<2!(PXCAITM2>80)
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,1)="Problem Name must be 2-80 Characters^"_PXCAITEM
+15 SET PXCAITEM=$PIECE(PXCAPROB,U,2)
+16 IF PXCAITEM]""
IF PXCAITEM>DT!(PXCAITEM<1800000)!($PIECE(+PXCAITEM,".")'=PXCAITEM)!(PXCAITEM>+$PIECE($PIECE(PXCA("ENCOUNTER"),"^"),"."))
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="Problem Onset Date is bad^"_PXCAITEM
+17 SET PXCAITEM=$PIECE(PXCAPROB,U,3)
+18 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,3)="Problem Active flag bad^"_PXCAITEM
+19 IF '$TEST
IF PXCAITEM=""
SET $PIECE(PXCA("PROBLEM",PXCAPRV,PXCAINDX),U,3)=1
+20 SET PXCAITEM=$PIECE(PXCAPROB,U,4)
+21 IF PXCAITEM]""
IF PXCAITEM>DT!(PXCAITEM<1800000)!($PIECE(+PXCAITEM,".")'=PXCAITEM)!(PXCAITEM>+$PIECE($PIECE(PXCA("ENCOUNTER"),"^"),"."))
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="Problem Resolved Date is bad^"_PXCAITEM
+22 SET PXCAITEM=$PIECE(PXCAPROB,U,5)
+23 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,5)="SC flag bad^"_PXCAITEM
+24 SET PXCAITEM=$PIECE(PXCAPROB,U,6)
+25 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,6)="AO flag bad^"_PXCAITEM
+26 SET PXCAITEM=$PIECE(PXCAPROB,U,7)
+27 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,7)="IR flag bad^"_PXCAITEM
+28 SET PXCAITEM=$PIECE(PXCAPROB,U,8)
+29 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,8)="EC flag bad^"_PXCAITEM
+30 ;PX*1*115 - ADD MST & HNC
+31 SET PXCAITEM=$PIECE(PXCAPROB,U,13)
+32 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,13)="MST flag bad^"_PXCAITEM
+33 SET PXCAITEM=$PIECE(PXCAPROB,U,14)
+34 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,14)="HNC flag bad^"_PXCAITEM
+35 SET PXCAITEM=$PIECE(PXCAPROB,U,15)
+36 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,14)="CV flag bad^"_PXCAITEM
+37 SET PXCAITEM=$PIECE(PXCAPROB,U,16)
+38 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,16)="PROJ 112/SHAD flag bad^"_PXCAITEM
+39 SET PXCAITEM=$PIECE(PXCAPROB,U,9)
+40 IF PXCAITEM>0
Begin DoDot:3
+41 SET PXCADIQ1=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
+42 IF $PIECE(PXCADIQ1,U,1)'>0
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="Diagnosis Code pointer results in a '"_$PIECE(PXCADIQ1,U,2)_"' error message.^"_PXCAITEM
+43 IF '$TEST
IF $PIECE(PXCADIQ1,U,10)'=1
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="Diagnosis Code is INACTIVE^"_PXCAITEM
End DoDot:3
+44 SET PXCAITEM=$PIECE(PXCAPROB,U,10)
+45 IF PXCAITEM]""
Begin DoDot:3
+46 IF $GET(^AUPNPROB(PXCAITEM,0))=""
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,10)="Problem not in file 9000011^"_PXCAITEM
+47 IF '$TEST
IF PXCAPAT'=$PIECE($GET(^AUPNPROB(PXCAITEM,0)),"^",2)
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,10)="Problem in file 9000011 is for a different Patient^"_PXCAITEM
End DoDot:3
+48 IF '$TEST
SET PXCAITEM=$PIECE(PXCAPROB,U,1)
IF PXCAITEM']""
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,1)="Problem Name required for a new Problem List entry^"_PXCAITEM
+49 SET PXCAITEM=$PIECE(PXCAPROB,U,11)
SET PXCAITM2=$LENGTH(PXCAITEM)
+50 IF PXCAITM2>60
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,11)="PROBLEM comment must be 1-60 Characters^"_PXCAITEM
+51 ;
+52 ;Clinical Lexicon Term
+53 SET PXCAITEM=$PIECE(PXCAPROB,"^",12)
+54 IF PXCAITEM]""
Begin DoDot:3
+55 IF $DATA(^LEX(757.01))
Begin DoDot:4
+56 IF $DATA(^LEX(757.01,PXCAITEM,0))#2'=1
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Lexicon Utility term is not in file 757.01^"_PXCAITEM
+57 IF '$TEST
SET PXCACLEX=PXCAITEM
End DoDot:4
+58 IF '$TEST
IF $DATA(^GMP(757.01))
Begin DoDot:4
+59 IF $DATA(^GMP(757.01,PXCAITEM,0))#2'=1
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM
+60 IF '$TEST
SET PXCACLEX=PXCAITEM
End DoDot:4
+61 IF '$TEST
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Lexicon Utility is not installed^"_PXCAITEM
End DoDot:3
End DoDot:2
End DoDot:1
+62 ;
+63 QUIT
+64 ;
