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,121,130,124,168,199**;Aug 12, 1996;Build 51
Q
; Variables
; PXCADIAG Copy of a Diagnosis node of the PXCA array
; PXCAPRV Pointer to the provider (200)
; PXCANPOV Count of the number of POVs
; PXCAINDX Count of the number of Diagnoses for one provider
;
DIAG(PXCA,PXCABULD,PXCAERRS) ;Validation routine for POV
N PXCADIAG,PXCAINDX,PXCAPRV,PXDXDATE
S PXDXDATE=$S($D(PXCAVSIT)=1:$$CSDATE^PXDXUTL(PXCAVSIT),$D(PXCADT)=1:PXCADT,1:DT)
S PXCAPRV=""
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))
.. I PXCADIAG="" S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,0)="DIAGNOSIS data missing" Q
.. S PXCANPOV=PXCANPOV+1
.. N PXCAITEM,PXCAITM2,PXCAPNAR,PXCANARC,PXCACLEX
.. ;
.. S PXCAITEM=$P(PXCADIAG,"^",1)
.. D
... N ICDSTR,ICDCN,ICDID
... S ICDSTR=$$ICDDATA^ICDXCODE("DIAG",$S(PXCAITEM'="":PXCAITEM,1:-1),PXDXDATE,"I")
... S ICDCN=$P(ICDSTR,"^",2)
... S ICDID=$P(ICDSTR,"^",12) I $L(ICDID) S ICDID=$$FMTE^XLFDT(ICDID,5)
... I +ICDSTR=-1 S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="Diagnosis Code pointer results in a '"_$P(ICDSTR,U,2)_"' error message.^"_PXCAITEM
... E I '$P(ICDSTR,"^",10) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="Diagnosis Code is INACTIVE"_$S($L(ICDID):" as of "_ICDID,1:"")_"^"_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,"^",11)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,11)="MST flag bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCADIAG,"^",12)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,12)="HNC flag bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCADIAG,"^",13)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,13)="CV flag bad^"_PXCAITEM ;CV
.. S PXCAITEM=$P(PXCADIAG,"^",14)
.. I '(PXCAITEM="R"!(PXCAITEM="O")!(PXCAITEM="RO")!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,14)="Ordering/Resulting field bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCADIAG,"^",14)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,15)="PROJ 112/SHAD 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,PXCANPOV,PXCAPRV,PXCAERRS)
Q
;
ANOTHPOV(PXCAAPOV) ;
;Add the diagnoses to V POV if they are not there.
;Quit if the provider subscript is zero
; Variables
; PXCAAPOV Pointer to the ICD DIAGNOSIS file [#80]
; PXCAINDX Subscript of the diagnosis in the temp array used to
; look to see if the above diagnosis is already known.
Q:PXCAAPOV'>0
N PXCAINDX
;See if this diagnosis is in the ^TMP(PXCAGLB,$J,
F PXCAINDX=1:1:PXCANPOV I PXCAAPOV=+$G(^TMP(PXCAGLB,$J,"POV",PXCAINDX,0,"AFTER")) S PXCAINDX=0 Q
Q:PXCAINDX'>0
S PXCAINDX=0
;See if this diagnosis is already in V POV for this Encounter
F S PXCAINDX=$O(^AUPNVPOV("AD",PXCAVSIT,PXCAAPOV)) Q:PXCAINDX'>0 I PXCAAPOV=$P(^AUPNVPOV(PXCAINDX,0),"^",1) Q
Q:PXCAINDX>0
S PXCANPOV=PXCANPOV+1
S ^TMP(PXCAGLB,$J,"POV",PXCANPOV,"IEN")=""
S ^TMP(PXCAGLB,$J,"POV",PXCANPOV,0,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"POV",PXCANPOV,0,"AFTER")=PXCAAPOV_"^"_PXCAPAT_"^"_PXCAVSIT_"^^^^^^^^^S"
S ^TMP(PXCAGLB,$J,"POV",PXCANPOV,812,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"POV",PXCANPOV,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCAPOV 6041 printed Dec 13, 2024@02:27:37 Page 2
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,121,130,124,168,199**;Aug 12, 1996;Build 51
+2 QUIT
+3 ; Variables
+4 ; PXCADIAG Copy of a Diagnosis node of the PXCA array
+5 ; PXCAPRV Pointer to the provider (200)
+6 ; PXCANPOV Count of the number of POVs
+7 ; PXCAINDX Count of the number of Diagnoses for one provider
+8 ;
DIAG(PXCA,PXCABULD,PXCAERRS) ;Validation routine for POV
+1 NEW PXCADIAG,PXCAINDX,PXCAPRV,PXDXDATE
+2 SET PXDXDATE=$SELECT($DATA(PXCAVSIT)=1:$$CSDATE^PXDXUTL(PXCAVSIT),$DATA(PXCADT)=1:PXCADT,1:DT)
+3 SET PXCAPRV=""
+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 IF PXCADIAG=""
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,0)="DIAGNOSIS data missing"
QUIT
+12 SET PXCANPOV=PXCANPOV+1
+13 NEW PXCAITEM,PXCAITM2,PXCAPNAR,PXCANARC,PXCACLEX
+14 ;
+15 SET PXCAITEM=$PIECE(PXCADIAG,"^",1)
+16 Begin DoDot:3
+17 NEW ICDSTR,ICDCN,ICDID
+18 SET ICDSTR=$$ICDDATA^ICDXCODE("DIAG",$SELECT(PXCAITEM'="":PXCAITEM,1:-1),PXDXDATE,"I")
+19 SET ICDCN=$PIECE(ICDSTR,"^",2)
+20 SET ICDID=$PIECE(ICDSTR,"^",12)
IF $LENGTH(ICDID)
SET ICDID=$$FMTE^XLFDT(ICDID,5)
+21 IF +ICDSTR=-1
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="Diagnosis Code pointer results in a '"_$PIECE(ICDSTR,U,2)_"' error message.^"_PXCAITEM
+22 IF '$TEST
IF '$PIECE(ICDSTR,"^",10)
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="Diagnosis Code is INACTIVE"_$SELECT($LENGTH(ICDID):" as of "_ICDID,1:"")_"^"_PXCAITEM
+23 ;
End DoDot:3
+24 SET PXCAITEM=$PIECE(PXCADIAG,"^",2)
+25 IF '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="S"))
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="Diagnosis specification code must be P|S^"_PXCAITEM
+26 IF '$TEST
IF PXCAITEM="P"
Begin DoDot:3
+27 IF 'PXCAPDX
SET PXCAPDX=$PIECE(PXCADIAG,"^",1)
+28 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
+29 IF '$TEST
Begin DoDot:4
+30 SET PXCA("WARNING","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis. This one is changed to Secondary^"_PXCAITEM
+31 SET $PIECE(PXCADIAG,"^",2)="S"
End DoDot:4
End DoDot:3
+32 SET PXCAITEM=$PIECE(PXCADIAG,"^",3)
+33 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,3)="SC flag bad^"_PXCAITEM
+34 SET PXCAITEM=$PIECE(PXCADIAG,"^",4)
+35 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,4)="AO flag bad^"_PXCAITEM
+36 SET PXCAITEM=$PIECE(PXCADIAG,"^",5)
+37 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,5)="IR flag bad^"_PXCAITEM
+38 SET PXCAITEM=$PIECE(PXCADIAG,"^",6)
+39 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,6)="EC flag bad^"_PXCAITEM
+40 SET PXCAITEM=$PIECE(PXCADIAG,"^",11)
+41 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,11)="MST flag bad^"_PXCAITEM
+42 SET PXCAITEM=$PIECE(PXCADIAG,"^",12)
+43 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,12)="HNC flag bad^"_PXCAITEM
+44 SET PXCAITEM=$PIECE(PXCADIAG,"^",13)
+45 ;CV
IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,13)="CV flag bad^"_PXCAITEM
+46 SET PXCAITEM=$PIECE(PXCADIAG,"^",14)
+47 IF '(PXCAITEM="R"!(PXCAITEM="O")!(PXCAITEM="RO")!(PXCAITEM=""))
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,14)="Ordering/Resulting field bad^"_PXCAITEM
+48 SET PXCAITEM=$PIECE(PXCADIAG,"^",14)
+49 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,15)="PROJ 112/SHAD flag bad^"_PXCAITEM
+50 SET PXCAITEM=$PIECE(PXCADIAG,"^",7)
+51 IF PXCAITEM]""
Begin DoDot:3
+52 IF $GET(^AUPNPROB(PXCAITEM,0))=""
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,7)="Problem not in file 9000011^"_PXCAITEM
+53 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
+54 ;
+55 ;Clinical Lexicon Term
+56 SET PXCAITEM=$PIECE(PXCADIAG,"^",10)
+57 IF PXCAITEM]""
Begin DoDot:3
+58 IF $DATA(^LEX(757.01))
Begin DoDot:4
+59 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
+60 IF '$TEST
SET PXCACLEX=PXCAITEM
End DoDot:4
+61 IF '$TEST
IF $DATA(^GMP(757.01))
Begin DoDot:4
+62 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
+63 IF '$TEST
SET PXCACLEX=PXCAITEM
End DoDot:4
+64 IF '$TEST
SET PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Lexicon Utility is not installed^"_PXCAITEM
End DoDot:3
+65 ;
+66 DO PART1^PXCAPOV1
+67 ;
+68 IF PXCABULD&'$DATA(PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX))!PXCAERRS
DO POV^PXCADX(PXCADIAG,PXCANPOV,PXCAPRV,PXCAERRS)
End DoDot:2
End DoDot:1
+69 QUIT
+70 ;
ANOTHPOV(PXCAAPOV) ;
+1 ;Add the diagnoses to V POV if they are not there.
+2 ;Quit if the provider subscript is zero
+3 ; Variables
+4 ; PXCAAPOV Pointer to the ICD DIAGNOSIS file [#80]
+5 ; PXCAINDX Subscript of the diagnosis in the temp array used to
+6 ; look to see if the above diagnosis is already known.
+7 if PXCAAPOV'>0
QUIT
+8 NEW PXCAINDX
+9 ;See if this diagnosis is in the ^TMP(PXCAGLB,$J,
+10 FOR PXCAINDX=1:1:PXCANPOV
IF PXCAAPOV=+$GET(^TMP(PXCAGLB,$JOB,"POV",PXCAINDX,0,"AFTER"))
SET PXCAINDX=0
QUIT
+11 if PXCAINDX'>0
QUIT
+12 SET PXCAINDX=0
+13 ;See if this diagnosis is already in V POV for this Encounter
+14 FOR
SET PXCAINDX=$ORDER(^AUPNVPOV("AD",PXCAVSIT,PXCAAPOV))
if PXCAINDX'>0
QUIT
IF PXCAAPOV=$PIECE(^AUPNVPOV(PXCAINDX,0),"^",1)
QUIT
+15 if PXCAINDX>0
QUIT
+16 SET PXCANPOV=PXCANPOV+1
+17 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANPOV,"IEN")=""
+18 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANPOV,0,"BEFORE")=""
+19 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANPOV,0,"AFTER")=PXCAAPOV_"^"_PXCAPAT_"^"_PXCAVSIT_"^^^^^^^^^S"
+20 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANPOV,812,"BEFORE")=""
+21 SET ^TMP(PXCAGLB,$JOB,"POV",PXCANPOV,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
+22 QUIT
+23 ;
