PXEDIEL ;ISL/PKR - PCE device interface error listing utilities. ;6/7/96
;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
;
;=======================================================================
ARRAY(PXCAEIEN) ;Restores the local array PXCA from the error file.
;;This comes from pcazfix.
K PXCA
N PXCAINDX,PXCAVAR
S PXCAINDX=0
F S PXCAINDX=$O(^PX(839.01,PXCAEIEN,2,PXCAINDX)) Q:PXCAINDX'>0 D
. S PXCAVAR=^PX(839.01,PXCAEIEN,2,PXCAINDX,0)
. S @PXCAVAR=$TR(^PX(839.01,PXCAEIEN,2,PXCAINDX,2),"~","^")
Q
;
;=======================================================================
ENC(ERRNUM) ;Try to return the encounter information for the error array.
N IND,DONE,ENCNTER,TEMP
S ENCNTER=""
S (DONE,IND)=0
F S IND=$O(^PX(839.01,ERRNUM,2,IND)) Q:('IND)!(DONE) D
. I ^PX(839.01,ERRNUM,2,IND,0)="PXCA(""ENCOUNTER"")" D
.. S ENCNTER=^PX(839.01,ERRNUM,2,IND,2)
.. S DONE=1
;
Q ENCNTER
;
;=======================================================================
ERRLST ;Write out the error list.
N AFTER,BEFORE,C1S,DFN,EM,ENCDATE,ENCNTER,ENTRY,ENUM,ERRMSG,EVAR
N IEN,FIELD,FIELDNAM,FILE,FILENAM,FILENUM,HLOCIEN,HLOCNAM,INDENT,NODE
N PATIENT,PXERR,TEMP,TEXT
;
S INDENT=3
S C1S=INDENT+3
;
;Setup the correspondence between abbreviations and file numbers.
S FILENUM("CPT")=9000010.18,FILENUM("HF")=9000010.23
S FILENUM("IMM")=9000010.11,FILENUM("PED")=9000010.16
S FILENUM("POV")=9000010.07,FILENUM("PRV")=9000010.06
S FILENUM("SK")=9000010.12,FILENUM("TRT")=9000010.15
S FILENUM("XAM")=9000010.13,FILENUM("VST")=9000010
;
S ENUM=0
;Build the error array.
F S ENUM=$O(^TMP("PXEDI",$J,TYPE,PATDFN,ENUM)) Q:(ENUM="")!(DONE) D
.;Check for a user request to stop the task.
. I $$S^%ZTLOAD S ZTSTOP=1,DONE=1 Q
.;
. S EM=^TMP("PXEDI",$J,TYPE,PATDFN,ENUM)
. S ENCNTER=$$ENC(ENUM)
. I ENCNTER>0 S ENCDATE=$P(ENCNTER,"~",1)
. E S ENCDATE=""
. S HLOCIEN=$P(ENCNTER,"~",3)
.;This is the same usage as in PXRRECSE. It should fall under the same
.;DBIA.
. I HLOCIEN>0 S HLOCNAM=$P(^SC(HLOCIEN,0),U,1)
. E S HLOCNAM="Missing"
. S DFN=$P(EM,U,2)
. D DEM^VADPT
. I $D(VADM(1)) S PATIENT=VADM(1)_" "_$P(VADM(2),U,2)
. E S PATIENT="Missing"
. D ARRAY(ENUM)
. I $Y>(IOSL-8) D PAGE^PXEDIP
. I DONE Q
. W !,"------------------------------------------------------------------------"
. W !,"Error Number: ",ENUM
. W !,?INDENT,"Patient: ",PATIENT
. W !,?INDENT,"Hospital Location: ",HLOCNAM
. W !,?INDENT,"Encounter date: "
. I +ENCDATE>0 W $$FMTE^XLFDT(ENCDATE)
. E W "Missing"
. W !,?INDENT,"Processing date: ",$$FMTE^XLFDT($P(EM,U,1))
.;
. S EVAR=0
. F S EVAR=$O(^PX(839.01,ENUM,1,EVAR)) Q:(EVAR="")!(DONE) D
.. S PXERR=$P($G(^PX(839.01,ENUM,1,1,0)),"(",2)
.. S TEXT=$G(^PX(839.01,ENUM,1,1,1))
.. S FILE=$P(PXERR,",",1),FILE=$TR(FILE,"""","")
.. S ENTRY=$P(PXERR,",",2)
.. S IEN=$P(PXERR,",",3)
.. I $L(IEN)=0 S IEN="Missing"
.. S FIELD=$P(PXERR,",",4),FIELD=$TR(FIELD,")","")
.. S FILENO=$G(FILENUM(FILE))
.. S NODE=""
.. I ($L(FILE)>0)&($L(ENTRY)>0) D
... S NODE=$O(^TMP("PXCA",$J,FILE,ENTRY,NODE))
.. I $L(NODE)>0 D
... S AFTER=$G(^TMP("PXCA",$J,FILE,ENTRY,NODE,"AFTER"))
... S BEFORE=$G(^TMP("PXCA",$J,FILE,ENTRY,NODE,"BEFORE"))
.. E S (AFTER,BEFORE,NODE)="Missing"
.. I FILENO>0 S FILENAM=$$GET1^DID(FILENO,"","","NAME","TEMP","ERRMSG")
.. E S FILENAM="Missing"
.. I $Y>(IOSL-8) D PAGE^PXEDIP
.. I DONE Q
.. W !!,?INDENT,"File: ",FILENO," (",FILENAM,")"
.. W " IEN: ",IEN
..;If FIELD=0 then the error applies to the entire entry, not just a
..;field.
.. I FIELD>0 D
... S FIELDNAM=$$GET1^DID(FILENO,FIELD,"","LABEL","TEMP","ERRMSG")
... W " Field ",FIELD," (",FIELDNAM,")"
.. W !,?INDENT,"Error message: ",TEXT
.. W !,?INDENT,"Node: ",NODE
.. W !,?C1S,"Original: ",BEFORE
.. W !,?C1S," Updated: ",AFTER
D KVA^VADPT
K PXCA
K ^TMP("PXCA",$J)
Q
;
PXEDIEL ;ISL/PKR - PCE device interface error listing utilities. ;6/7/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
+2 ;
+3 ;=======================================================================
ARRAY(PXCAEIEN) ;Restores the local array PXCA from the error file.
+1 ;;This comes from pcazfix.
+2 KILL PXCA
+3 NEW PXCAINDX,PXCAVAR
+4 SET PXCAINDX=0
+5 FOR
SET PXCAINDX=$ORDER(^PX(839.01,PXCAEIEN,2,PXCAINDX))
IF PXCAINDX'>0
QUIT
Begin DoDot:1
+6 SET PXCAVAR=^PX(839.01,PXCAEIEN,2,PXCAINDX,0)
+7 SET @PXCAVAR=$TRANSLATE(^PX(839.01,PXCAEIEN,2,PXCAINDX,2),"~","^")
End DoDot:1
+8 QUIT
+9 ;
+10 ;=======================================================================
ENC(ERRNUM) ;Try to return the encounter information for the error array.
+1 NEW IND,DONE,ENCNTER,TEMP
+2 SET ENCNTER=""
+3 SET (DONE,IND)=0
+4 FOR
SET IND=$ORDER(^PX(839.01,ERRNUM,2,IND))
IF ('IND)!(DONE)
QUIT
Begin DoDot:1
+5 IF ^PX(839.01,ERRNUM,2,IND,0)="PXCA(""ENCOUNTER"")"
Begin DoDot:2
+6 SET ENCNTER=^PX(839.01,ERRNUM,2,IND,2)
+7 SET DONE=1
End DoDot:2
End DoDot:1
+8 ;
+9 QUIT ENCNTER
+10 ;
+11 ;=======================================================================
ERRLST ;Write out the error list.
+1 NEW AFTER,BEFORE,C1S,DFN,EM,ENCDATE,ENCNTER,ENTRY,ENUM,ERRMSG,EVAR
+2 NEW IEN,FIELD,FIELDNAM,FILE,FILENAM,FILENUM,HLOCIEN,HLOCNAM,INDENT,NODE
+3 NEW PATIENT,PXERR,TEMP,TEXT
+4 ;
+5 SET INDENT=3
+6 SET C1S=INDENT+3
+7 ;
+8 ;Setup the correspondence between abbreviations and file numbers.
+9 SET FILENUM("CPT")=9000010.18
SET FILENUM("HF")=9000010.23
+10 SET FILENUM("IMM")=9000010.11
SET FILENUM("PED")=9000010.16
+11 SET FILENUM("POV")=9000010.07
SET FILENUM("PRV")=9000010.06
+12 SET FILENUM("SK")=9000010.12
SET FILENUM("TRT")=9000010.15
+13 SET FILENUM("XAM")=9000010.13
SET FILENUM("VST")=9000010
+14 ;
+15 SET ENUM=0
+16 ;Build the error array.
+17 FOR
SET ENUM=$ORDER(^TMP("PXEDI",$JOB,TYPE,PATDFN,ENUM))
IF (ENUM="")!(DONE)
QUIT
Begin DoDot:1
+18 ;Check for a user request to stop the task.
+19 IF $$S^%ZTLOAD
SET ZTSTOP=1
SET DONE=1
QUIT
+20 ;
+21 SET EM=^TMP("PXEDI",$JOB,TYPE,PATDFN,ENUM)
+22 SET ENCNTER=$$ENC(ENUM)
+23 IF ENCNTER>0
SET ENCDATE=$PIECE(ENCNTER,"~",1)
+24 IF '$TEST
SET ENCDATE=""
+25 SET HLOCIEN=$PIECE(ENCNTER,"~",3)
+26 ;This is the same usage as in PXRRECSE. It should fall under the same
+27 ;DBIA.
+28 IF HLOCIEN>0
SET HLOCNAM=$PIECE(^SC(HLOCIEN,0),U,1)
+29 IF '$TEST
SET HLOCNAM="Missing"
+30 SET DFN=$PIECE(EM,U,2)
+31 DO DEM^VADPT
+32 IF $DATA(VADM(1))
SET PATIENT=VADM(1)_" "_$PIECE(VADM(2),U,2)
+33 IF '$TEST
SET PATIENT="Missing"
+34 DO ARRAY(ENUM)
+35 IF $Y>(IOSL-8)
DO PAGE^PXEDIP
+36 IF DONE
QUIT
+37 WRITE !,"------------------------------------------------------------------------"
+38 WRITE !,"Error Number: ",ENUM
+39 WRITE !,?INDENT,"Patient: ",PATIENT
+40 WRITE !,?INDENT,"Hospital Location: ",HLOCNAM
+41 WRITE !,?INDENT,"Encounter date: "
+42 IF +ENCDATE>0
WRITE $$FMTE^XLFDT(ENCDATE)
+43 IF '$TEST
WRITE "Missing"
+44 WRITE !,?INDENT,"Processing date: ",$$FMTE^XLFDT($PIECE(EM,U,1))
+45 ;
+46 SET EVAR=0
+47 FOR
SET EVAR=$ORDER(^PX(839.01,ENUM,1,EVAR))
IF (EVAR="")!(DONE)
QUIT
Begin DoDot:2
+48 SET PXERR=$PIECE($GET(^PX(839.01,ENUM,1,1,0)),"(",2)
+49 SET TEXT=$GET(^PX(839.01,ENUM,1,1,1))
+50 SET FILE=$PIECE(PXERR,",",1)
SET FILE=$TRANSLATE(FILE,"""","")
+51 SET ENTRY=$PIECE(PXERR,",",2)
+52 SET IEN=$PIECE(PXERR,",",3)
+53 IF $LENGTH(IEN)=0
SET IEN="Missing"
+54 SET FIELD=$PIECE(PXERR,",",4)
SET FIELD=$TRANSLATE(FIELD,")","")
+55 SET FILENO=$GET(FILENUM(FILE))
+56 SET NODE=""
+57 IF ($LENGTH(FILE)>0)&($LENGTH(ENTRY)>0)
Begin DoDot:3
+58 SET NODE=$ORDER(^TMP("PXCA",$JOB,FILE,ENTRY,NODE))
End DoDot:3
+59 IF $LENGTH(NODE)>0
Begin DoDot:3
+60 SET AFTER=$GET(^TMP("PXCA",$JOB,FILE,ENTRY,NODE,"AFTER"))
+61 SET BEFORE=$GET(^TMP("PXCA",$JOB,FILE,ENTRY,NODE,"BEFORE"))
End DoDot:3
+62 IF '$TEST
SET (AFTER,BEFORE,NODE)="Missing"
+63 IF FILENO>0
SET FILENAM=$$GET1^DID(FILENO,"","","NAME","TEMP","ERRMSG")
+64 IF '$TEST
SET FILENAM="Missing"
+65 IF $Y>(IOSL-8)
DO PAGE^PXEDIP
+66 IF DONE
QUIT
+67 WRITE !!,?INDENT,"File: ",FILENO," (",FILENAM,")"
+68 WRITE " IEN: ",IEN
+69 ;If FIELD=0 then the error applies to the entire entry, not just a
+70 ;field.
+71 IF FIELD>0
Begin DoDot:3
+72 SET FIELDNAM=$$GET1^DID(FILENO,FIELD,"","LABEL","TEMP","ERRMSG")
+73 WRITE " Field ",FIELD," (",FIELDNAM,")"
End DoDot:3
+74 WRITE !,?INDENT,"Error message: ",TEXT
+75 WRITE !,?INDENT,"Node: ",NODE
+76 WRITE !,?C1S,"Original: ",BEFORE
+77 WRITE !,?C1S," Updated: ",AFTER
End DoDot:2
End DoDot:1
+78 DO KVA^VADPT
+79 KILL PXCA
+80 KILL ^TMP("PXCA",$JOB)
+81 QUIT
+82 ;
