PXCADXPL ;ISL/dee & LEA/Chylton - Validates & Translates data from the PCE Device Interface into a call to V POV & update Problem List ;3/14/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**27,33,115**;Aug 12, 1996
Q
;
; Variables
; PXCADXPL Copy of a DIAGNOSIS/PROBLEM node of the PXCA array
; PXCAPRV Pointer to the provider (200)
; PXCANUMB Count of the number of POVs
; PXCAINDX Count of the number of Diagnoses for one provider
; PXCADIAG Flag for this entry is a Diagnosis
; PXCAPROB Flag for this entry is a Problem
; PXCACLEX IEN to Clinical Lexicon
; PXCAITEM,PXCAITM2,PXCAITM3 Temporaries for item being checked
;
DXPL(PXCA,PXCABULD,PXCAERRS) ;Validation routine for POV & Problem List together
I '$D(PXCA("DIAGNOSIS/PROBLEM")) Q
N PXCADXPL,PXCAPRV,PXCANUMB,PXCAINDX
N PXCAITEM,PXCAITM2,PXCAITM3
N PXCADIAG,PXCAPROB
S PXCAPRV=""
S PXCANUMB=+$O(^TMP(+$G(PXCAGLB),$J,"POV",""),-1)
F S PXCAPRV=$O(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV)) Q:PXCAPRV']"" D
. I PXCAPRV>0 D
.. I '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT) S PXCA("ERROR","DIAGNOSIS/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("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
.. S PXCADXPL=$G(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX))
.. S PXCANUMB=PXCANUMB+1
.. S PXCADNUM(PXCAPRV,PXCAINDX)=PXCANUMB
.. I PXCADXPL="" S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,0)="DIAGNOSIS/PROBLEM data missing" Q
.. ;
.. D PART1^PXCADXP1 ;Pieces 1 through 5 and the NOTE
.. D PART2^PXCADXP2 ;Pieces 6 through 16
.. ;
.. ;What is it? I do not know.
.. I '(PXCADIAG!PXCAPROB) S PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,0)="DIAGNOSIS/PROBLEM is not used as a Diagnosis or as a Problem"
.. ;
.. ;Translate data for POV
.. I PXCADIAG&PXCABULD&'$D(PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX))!PXCAERRS D DX^PXCADX(PXCADXPL,PXCANUMB,PXCAPRV,PXCAERRS)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCADXPL 2035 printed Nov 22, 2024@17:37:31 Page 2
PXCADXPL ;ISL/dee & LEA/Chylton - Validates & Translates data from the PCE Device Interface into a call to V POV & update Problem List ;3/14/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**27,33,115**;Aug 12, 1996
+2 QUIT
+3 ;
+4 ; Variables
+5 ; PXCADXPL Copy of a DIAGNOSIS/PROBLEM node of the PXCA array
+6 ; PXCAPRV Pointer to the provider (200)
+7 ; PXCANUMB Count of the number of POVs
+8 ; PXCAINDX Count of the number of Diagnoses for one provider
+9 ; PXCADIAG Flag for this entry is a Diagnosis
+10 ; PXCAPROB Flag for this entry is a Problem
+11 ; PXCACLEX IEN to Clinical Lexicon
+12 ; PXCAITEM,PXCAITM2,PXCAITM3 Temporaries for item being checked
+13 ;
DXPL(PXCA,PXCABULD,PXCAERRS) ;Validation routine for POV & Problem List together
+1 IF '$DATA(PXCA("DIAGNOSIS/PROBLEM"))
QUIT
+2 NEW PXCADXPL,PXCAPRV,PXCANUMB,PXCAINDX
+3 NEW PXCAITEM,PXCAITM2,PXCAITM3
+4 NEW PXCADIAG,PXCAPROB
+5 SET PXCAPRV=""
+6 SET PXCANUMB=+$ORDER(^TMP(+$GET(PXCAGLB),$JOB,"POV",""),-1)
+7 FOR
SET PXCAPRV=$ORDER(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV))
if PXCAPRV']""
QUIT
Begin DoDot:1
+8 IF PXCAPRV>0
Begin DoDot:2
+9 IF '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT)
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
+10 IF '$TEST
IF PXCABULD!PXCAERRS
DO ANOTHPRV^PXCAPRV(PXCAPRV)
End DoDot:2
+11 SET PXCAINDX=0
+12 FOR
SET PXCAINDX=$ORDER(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX))
if PXCAINDX']""
QUIT
Begin DoDot:2
+13 SET PXCADXPL=$GET(PXCA("DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX))
+14 SET PXCANUMB=PXCANUMB+1
+15 SET PXCADNUM(PXCAPRV,PXCAINDX)=PXCANUMB
+16 IF PXCADXPL=""
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,0)="DIAGNOSIS/PROBLEM data missing"
QUIT
+17 ;
+18 ;Pieces 1 through 5 and the NOTE
DO PART1^PXCADXP1
+19 ;Pieces 6 through 16
DO PART2^PXCADXP2
+20 ;
+21 ;What is it? I do not know.
+22 IF '(PXCADIAG!PXCAPROB)
SET PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX,0)="DIAGNOSIS/PROBLEM is not used as a Diagnosis or as a Problem"
+23 ;
+24 ;Translate data for POV
+25 IF PXCADIAG&PXCABULD&'$DATA(PXCA("ERROR","DIAGNOSIS/PROBLEM",PXCAPRV,PXCAINDX))!PXCAERRS
DO DX^PXCADX(PXCADXPL,PXCANUMB,PXCAPRV,PXCAERRS)
End DoDot:2
End DoDot:1
+26 QUIT
+27 ;
