- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXEDIEL 3951 printed Dec 13, 2024@02:28:41 Page 2
- 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 ;