PXRMEXCC ; SLC/PKR - Exchange component check. ;07/02/2020
;;2.0;CLINICAL REMINDERS;**47,74**;Feb 04, 2005;Build 5
;Used to find corrupted components, the indicator is when the Index
;is not at the proper line in the Exchange file.
;======================================================
COMPCHK(IEN) ;Check the components for the Exchange entry.
N BADIND,CSTART,CEND,END,FDAEND,FDASTART,FILENAME,FILENUM,IND,INDEXAT
N JND,LINE,LNUM,NCMPNT,START,SUB,TAG,TEXT,TYPE
;Find the Index
S (IND,INDEXAT)=0
F S IND=$O(^PXD(811.8,IEN,100,IND)) Q:(INDEXAT>0)!(IND="") D
. S LINE=^PXD(811.8,IEN,100,IND,0)
. I LINE="<INDEX>" S INDEXAT=IND
S JND=INDEXAT+1
S LINE=^PXD(811.8,IEN,100,JND,0)
S NCMPNT=+$$GETTAGV^PXRMEXU3(LINE,"<NUMBER_OF_COMPONENTS>")
;Build the list of components.
K ^TMP($J,"CMPNT")
F IND=1:1:NCMPNT D
. K END,START
. F S JND=JND+1,LINE=$G(^PXD(811.8,IEN,100,JND,0)) Q:(LINE="</COMPONENT>")!(LINE="") D
.. S TAG=$$GETTAG^PXRMEXU3(LINE)
.. I TAG["START" S START(TAG)=+$$GETTAGV^PXRMEXU3(LINE,TAG)
.. I TAG["END" S END(TAG)=+$$GETTAGV^PXRMEXU3(LINE,TAG)
. I $D(START("<M_ROUTINE_START>")) D
.. S CSTART=START("<M_ROUTINE_START>")
.. S ^TMP($J,"CMPNT",IND,"TYPE")="ROUTINE"
.. S LINE=^PXD(811.8,IEN,100,CSTART+1,0)
.. S ^TMP($J,"CMPNT",IND,"NAME")=$$GETTAGV^PXRMEXU3(LINE,"<ROUTINE_NAME>")
.. S ^TMP($J,"CMPNT",IND,"FILENUM")=0
..;Save the actual start and end of the code.
.. S ^TMP($J,"CMPNT",IND,"START")=START("<ROUTINE_CODE_START>")
.. S ^TMP($J,"CMPNT",IND,"END")=END("<ROUTINE_CODE_END>")
. I $D(START("<FILE_START>")) D
.. S CSTART=START("<FILE_START>")
.. S LINE=^PXD(811.8,IEN,100,CSTART+1,0)
.. S (^TMP($J,"CMPNT",IND,"TYPE"),^TMP($J,"CMPNT",IND,"FILENAME"))=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NAME>",1)
.. S LINE=^PXD(811.8,IEN,100,CSTART+2,0)
.. S ^TMP($J,"CMPNT",IND,"FILENUM")=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NUMBER>")
.. S LINE=^PXD(811.8,IEN,100,CSTART+3,0)
.. S (^TMP($J,"CMPNT",IND,"NAME"),^TMP($J,"CMPNT",IND,"POINT_01"))=$$GETTAGV^PXRMEXU3(LINE,"<POINT_01>",1)
.. S LINE=^PXD(811.8,IEN,100,CSTART+6,0)
.. S ^TMP($J,"CMPNT",IND,"SELECTED")=$$GETTAGV^PXRMEXU3(LINE,"<SELECTED>")
..;Save the actual start and end of the FileMan FDA.
.. S ^TMP($J,"CMPNT",IND,"FDA_START")=START("<FDA_START>")
.. S ^TMP($J,"CMPNT",IND,"FDA_END")=END("<FDA_END>")
.. S ^TMP($J,"CMPNT",IND,"IEN_ROOT_START")=$G(START("<IEN_ROOT_START>"))
.. S ^TMP($J,"CMPNT",IND,"IEN_ROOT_END")=$G(END("<IEN_ROOT_END>"))
;Look for missing TYPE, this is an indicator of an issue.
S TEXT(1)="Component check for Exchange Entry IEN="_IEN_"."
S LNUM=1
;Look for missing component Type, FDA_END, and FDA_START.
S BADIND=0,IND=1
I $G(^TMP($J,"CMPNT",1,"TYPE"))="" S BADIND=1
F S IND=$O(^TMP($J,"CMPNT",IND)) Q:(BADIND)!(IND="") D
. S TYPE=$G(^TMP($J,"CMPNT",IND,"TYPE"))
. I TYPE="" S BADIND=IND
. S FDAEND=$G(^TMP($J,"CMPNT",IND,"FDA_END"))
. I $G(^PXD(811.8,IEN,100,(FDAEND+1),0))'="]]>" S BADIND=IND
. S FDASTART=$G(^TMP($J,"CMPNT",IND,"FDA_START"))
. I $G(^PXD(811.8,IEN,100,FDASTART,0))'[".01" S BADIND=IND
I BADIND=0 D Q
. S LNUM=LNUM+1,TEXT(LNUM)="Cannot determine the problem."
. D DISPLAY(LNUM,.TEXT)
. K ^TMP($J,"CMPNT")
I BADIND>0 D
. S LNUM=LNUM+1,TEXT(LNUM)="There appears to be a problem in this component area."
. S LNUM=LNUM+1,TEXT(LNUM)="Most likely it is component "_BADIND_"."
. S CSTART=$S(BADIND>1:(BADIND-1),1:1)
. S CEND=$O(^TMP($J,"CMPNT",""),-1)
. S CEND=$S(BADIND=CEND:CEND,1:(BADIND+1))
. F IND=CSTART:1:CEND D
.. S LNUM=LNUM+1,TEXT(LNUM)=""
.. S LNUM=LNUM+1,TEXT(LNUM)="Component number "_IND
.. S SUB=""
.. F S SUB=$O(^TMP($J,"CMPNT",IND,SUB)) Q:SUB="" D
... S LNUM=LNUM+1,TEXT(LNUM)=" "_SUB_"="_^TMP($J,"CMPNT",IND,SUB)
.. S LNUM=LNUM+1,TEXT(LNUM)=""
.. S LNUM=LNUM+1,TEXT(LNUM)="The component details are:"
.. S START=^TMP($J,"CMPNT",IND,"FDA_START")-2
.. S END=^TMP($J,"CMPNT",IND,"FDA_END")+2
.. F JND=START:1:END S LNUM=LNUM+1,TEXT(LNUM)=^PXD(811.8,IEN,100,JND,0)
D DISPLAY(LNUM,.TEXT)
K ^TMP($J,"CMPNT")
Q
;
;===============
DISPLAY(LNUM,TEXT) ;Display the error information.
S LNUM=LNUM+1,TEXT(LNUM)=""
S LNUM=LNUM+1,TEXT(LNUM)="If you need assistance with this, call the National Help Desk and have them"
S LNUM=LNUM+1,TEXT(LNUM)="enter a ticket."
D BROWSE^DDBR("TEXT","N","Corrupted Component Information")
I $D(DDS) D REFRESH^DDSUTL S DY=IOSL-7,DX=0 X IOXY S $Y=DY,$X=DX
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXCC 4481 printed Dec 13, 2024@01:44:49 Page 2
PXRMEXCC ; SLC/PKR - Exchange component check. ;07/02/2020
+1 ;;2.0;CLINICAL REMINDERS;**47,74**;Feb 04, 2005;Build 5
+2 ;Used to find corrupted components, the indicator is when the Index
+3 ;is not at the proper line in the Exchange file.
+4 ;======================================================
COMPCHK(IEN) ;Check the components for the Exchange entry.
+1 NEW BADIND,CSTART,CEND,END,FDAEND,FDASTART,FILENAME,FILENUM,IND,INDEXAT
+2 NEW JND,LINE,LNUM,NCMPNT,START,SUB,TAG,TEXT,TYPE
+3 ;Find the Index
+4 SET (IND,INDEXAT)=0
+5 FOR
SET IND=$ORDER(^PXD(811.8,IEN,100,IND))
if (INDEXAT>0)!(IND="")
QUIT
Begin DoDot:1
+6 SET LINE=^PXD(811.8,IEN,100,IND,0)
+7 IF LINE="<INDEX>"
SET INDEXAT=IND
End DoDot:1
+8 SET JND=INDEXAT+1
+9 SET LINE=^PXD(811.8,IEN,100,JND,0)
+10 SET NCMPNT=+$$GETTAGV^PXRMEXU3(LINE,"<NUMBER_OF_COMPONENTS>")
+11 ;Build the list of components.
+12 KILL ^TMP($JOB,"CMPNT")
+13 FOR IND=1:1:NCMPNT
Begin DoDot:1
+14 KILL END,START
+15 FOR
SET JND=JND+1
SET LINE=$GET(^PXD(811.8,IEN,100,JND,0))
if (LINE="</COMPONENT>")!(LINE="")
QUIT
Begin DoDot:2
+16 SET TAG=$$GETTAG^PXRMEXU3(LINE)
+17 IF TAG["START"
SET START(TAG)=+$$GETTAGV^PXRMEXU3(LINE,TAG)
+18 IF TAG["END"
SET END(TAG)=+$$GETTAGV^PXRMEXU3(LINE,TAG)
End DoDot:2
+19 IF $DATA(START("<M_ROUTINE_START>"))
Begin DoDot:2
+20 SET CSTART=START("<M_ROUTINE_START>")
+21 SET ^TMP($JOB,"CMPNT",IND,"TYPE")="ROUTINE"
+22 SET LINE=^PXD(811.8,IEN,100,CSTART+1,0)
+23 SET ^TMP($JOB,"CMPNT",IND,"NAME")=$$GETTAGV^PXRMEXU3(LINE,"<ROUTINE_NAME>")
+24 SET ^TMP($JOB,"CMPNT",IND,"FILENUM")=0
+25 ;Save the actual start and end of the code.
+26 SET ^TMP($JOB,"CMPNT",IND,"START")=START("<ROUTINE_CODE_START>")
+27 SET ^TMP($JOB,"CMPNT",IND,"END")=END("<ROUTINE_CODE_END>")
End DoDot:2
+28 IF $DATA(START("<FILE_START>"))
Begin DoDot:2
+29 SET CSTART=START("<FILE_START>")
+30 SET LINE=^PXD(811.8,IEN,100,CSTART+1,0)
+31 SET (^TMP($JOB,"CMPNT",IND,"TYPE"),^TMP($JOB,"CMPNT",IND,"FILENAME"))=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NAME>",1)
+32 SET LINE=^PXD(811.8,IEN,100,CSTART+2,0)
+33 SET ^TMP($JOB,"CMPNT",IND,"FILENUM")=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NUMBER>")
+34 SET LINE=^PXD(811.8,IEN,100,CSTART+3,0)
+35 SET (^TMP($JOB,"CMPNT",IND,"NAME"),^TMP($JOB,"CMPNT",IND,"POINT_01"))=$$GETTAGV^PXRMEXU3(LINE,"<POINT_01>",1)
+36 SET LINE=^PXD(811.8,IEN,100,CSTART+6,0)
+37 SET ^TMP($JOB,"CMPNT",IND,"SELECTED")=$$GETTAGV^PXRMEXU3(LINE,"<SELECTED>")
+38 ;Save the actual start and end of the FileMan FDA.
+39 SET ^TMP($JOB,"CMPNT",IND,"FDA_START")=START("<FDA_START>")
+40 SET ^TMP($JOB,"CMPNT",IND,"FDA_END")=END("<FDA_END>")
+41 SET ^TMP($JOB,"CMPNT",IND,"IEN_ROOT_START")=$GET(START("<IEN_ROOT_START>"))
+42 SET ^TMP($JOB,"CMPNT",IND,"IEN_ROOT_END")=$GET(END("<IEN_ROOT_END>"))
End DoDot:2
End DoDot:1
+43 ;Look for missing TYPE, this is an indicator of an issue.
+44 SET TEXT(1)="Component check for Exchange Entry IEN="_IEN_"."
+45 SET LNUM=1
+46 ;Look for missing component Type, FDA_END, and FDA_START.
+47 SET BADIND=0
SET IND=1
+48 IF $GET(^TMP($JOB,"CMPNT",1,"TYPE"))=""
SET BADIND=1
+49 FOR
SET IND=$ORDER(^TMP($JOB,"CMPNT",IND))
if (BADIND)!(IND="")
QUIT
Begin DoDot:1
+50 SET TYPE=$GET(^TMP($JOB,"CMPNT",IND,"TYPE"))
+51 IF TYPE=""
SET BADIND=IND
+52 SET FDAEND=$GET(^TMP($JOB,"CMPNT",IND,"FDA_END"))
+53 IF $GET(^PXD(811.8,IEN,100,(FDAEND+1),0))'="]]>"
SET BADIND=IND
+54 SET FDASTART=$GET(^TMP($JOB,"CMPNT",IND,"FDA_START"))
+55 IF $GET(^PXD(811.8,IEN,100,FDASTART,0))'[".01"
SET BADIND=IND
End DoDot:1
+56 IF BADIND=0
Begin DoDot:1
+57 SET LNUM=LNUM+1
SET TEXT(LNUM)="Cannot determine the problem."
+58 DO DISPLAY(LNUM,.TEXT)
+59 KILL ^TMP($JOB,"CMPNT")
End DoDot:1
QUIT
+60 IF BADIND>0
Begin DoDot:1
+61 SET LNUM=LNUM+1
SET TEXT(LNUM)="There appears to be a problem in this component area."
+62 SET LNUM=LNUM+1
SET TEXT(LNUM)="Most likely it is component "_BADIND_"."
+63 SET CSTART=$SELECT(BADIND>1:(BADIND-1),1:1)
+64 SET CEND=$ORDER(^TMP($JOB,"CMPNT",""),-1)
+65 SET CEND=$SELECT(BADIND=CEND:CEND,1:(BADIND+1))
+66 FOR IND=CSTART:1:CEND
Begin DoDot:2
+67 SET LNUM=LNUM+1
SET TEXT(LNUM)=""
+68 SET LNUM=LNUM+1
SET TEXT(LNUM)="Component number "_IND
+69 SET SUB=""
+70 FOR
SET SUB=$ORDER(^TMP($JOB,"CMPNT",IND,SUB))
if SUB=""
QUIT
Begin DoDot:3
+71 SET LNUM=LNUM+1
SET TEXT(LNUM)=" "_SUB_"="_^TMP($JOB,"CMPNT",IND,SUB)
End DoDot:3
+72 SET LNUM=LNUM+1
SET TEXT(LNUM)=""
+73 SET LNUM=LNUM+1
SET TEXT(LNUM)="The component details are:"
+74 SET START=^TMP($JOB,"CMPNT",IND,"FDA_START")-2
+75 SET END=^TMP($JOB,"CMPNT",IND,"FDA_END")+2
+76 FOR JND=START:1:END
SET LNUM=LNUM+1
SET TEXT(LNUM)=^PXD(811.8,IEN,100,JND,0)
End DoDot:2
End DoDot:1
+77 DO DISPLAY(LNUM,.TEXT)
+78 KILL ^TMP($JOB,"CMPNT")
+79 QUIT
+80 ;
+81 ;===============
DISPLAY(LNUM,TEXT) ;Display the error information.
+1 SET LNUM=LNUM+1
SET TEXT(LNUM)=""
+2 SET LNUM=LNUM+1
SET TEXT(LNUM)="If you need assistance with this, call the National Help Desk and have them"
+3 SET LNUM=LNUM+1
SET TEXT(LNUM)="enter a ticket."
+4 DO BROWSE^DDBR("TEXT","N","Corrupted Component Information")
+5 IF $DATA(DDS)
DO REFRESH^DDSUTL
SET DY=IOSL-7
SET DX=0
XECUTE IOXY
SET $Y=DY
SET $X=DX
+6 QUIT
+7 ;
