PXCAPL ;ISL/dee & LEA/Chylton - Validates data from the PCE Device Interface into a call to update Problem List ;3/20/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**24,27,115**;Aug 12, 1996
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 PXCAPROB,PXCAPRV,PXCAINDX
N PXCAITEM,PXCAITM2
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,9)
.. 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","PROBLEM",PXCAPRV,PXCAINDX,9)="ICD9 Code not in file 80^"_PXCAITEM
... E I $G(PXCADIQ1(80,DA,102,"I")),PXCADIQ1(80,DA,102,"I")'>+PXCADT S PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="ICD9 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
;
PXCAPL ;ISL/dee & LEA/Chylton - Validates data from the PCE Device Interface into a call to update Problem List ;3/20/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,27,115**;Aug 12, 1996
+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 PXCAPROB,PXCAPRV,PXCAINDX
+4 NEW PXCAITEM,PXCAITM2
+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,9)
+36 IF PXCAITEM>0
Begin DoDot:3
+37 NEW DIC,DR,DA,DIQ,PXCADIQ1
+38 SET DIC=80
+39 SET DR=".01;102"
+40 SET DA=PXCAITEM
+41 SET DIQ="PXCADIQ1("
+42 SET DIQ(0)="I"
+43 DO EN^DIQ1
+44 IF $GET(PXCADIQ1(80,DA,.01,"I"))=""
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="ICD9 Code not in file 80^"_PXCAITEM
+45 IF '$TEST
IF $GET(PXCADIQ1(80,DA,102,"I"))
IF PXCADIQ1(80,DA,102,"I")'>+PXCADT
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,9)="ICD9 Code is INACTIVE^"_PXCAITEM
End DoDot:3
+46 SET PXCAITEM=$PIECE(PXCAPROB,U,10)
+47 IF PXCAITEM]""
Begin DoDot:3
+48 IF $GET(^AUPNPROB(PXCAITEM,0))=""
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,10)="Problem not in file 9000011^"_PXCAITEM
+49 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
+50 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
+51 SET PXCAITEM=$PIECE(PXCAPROB,U,11)
SET PXCAITM2=$LENGTH(PXCAITEM)
+52 IF PXCAITM2>60
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,11)="PROBLEM comment must be 1-60 Characters^"_PXCAITEM
+53 ;
+54 ;Clinical Lexicon Term
+55 SET PXCAITEM=$PIECE(PXCAPROB,"^",12)
+56 IF PXCAITEM]""
Begin DoDot:3
+57 IF $DATA(^LEX(757.01))
Begin DoDot:4
+58 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
+59 IF '$TEST
SET PXCACLEX=PXCAITEM
End DoDot:4
+60 IF '$TEST
IF $DATA(^GMP(757.01))
Begin DoDot:4
+61 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
+62 IF '$TEST
SET PXCACLEX=PXCAITEM
End DoDot:4
+63 IF '$TEST
SET PXCA("ERROR","PROBLEM",PXCAPRV,PXCAINDX,12)="Lexicon Utility is not installed^"_PXCAITEM
End DoDot:3
End DoDot:2
End DoDot:1
+64 ;
+65 QUIT
+66 ;
