PXRMEXCO ; SLC/PKR/PJH - Exchange File component order. ;03/30/2009
;;2.0;CLINICAL REMINDERS;**12**;Feb 04, 2005;Build 73
;======================================================
CLIST(IEN,CLOK) ;Build the list of components for the repository
;entry IEN.
N COMIND,COMORDR,CSTART,CSUM,END,FILENAME,FILENUM
N IND,INDEXAT,IOKTI,JND,LINE,LRDL,NCMPNT,NITEMS,NLINES,NUCMPNT
N PT01,SELECT,START,TEMP,TAG,TYPE,UCOM,VERSN
S LINE=^PXD(811.8,IEN,100,1,0)
;Make sure it is XML version 1.
I LINE'["<?xml version=""1.0""" D Q
. S CLOK=0
. W !,"Exchange file entry not in proper format!"
. H 2
S LINE=^PXD(811.8,IEN,100,2,0)
I LINE'="<REMINDER_EXCHANGE_FILE_ENTRY>" D Q
. S CLOK=0
. W !,"Not an Exchange File entry!"
. H 2
S LINE=^PXD(811.8,IEN,100,3,0)
S VERSN=$$GETTAGV^PXRMEXU3(LINE,"<PACKAGE_VERSION>")
S LINE=^PXD(811.8,IEN,100,4,0)
S INDEXAT=+$P(LINE,"<INDEX_AT>",2)
S LINE=^PXD(811.8,IEN,100,INDEXAT,0)
I LINE'="<INDEX>" D Q
. S CLOK=0
. W !,"Index missing, cannot continue!"
. H 2
S CLOK=1
K ^PXD(811.8,IEN,119),^PXD(811.8,IEN,120)
S JND=INDEXAT+1
S LINE=^PXD(811.8,IEN,100,JND,0)
S NCMPNT=+$$GETTAGV^PXRMEXU3(LINE,"<NUMBER_OF_COMPONENTS>")
K ^TMP($J,"CMPNT")
F IND=1:1:NCMPNT D
. K END,START
. F S JND=JND+1,LINE=^PXD(811.8,IEN,100,JND,0) Q:LINE="</COMPONENT>" 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>"))
;Build some indexes to order the component list.
F IND=1:1:NCMPNT D
. S TYPE=^TMP($J,"CMPNT",IND,"TYPE")
. S FILENUM=^TMP($J,"CMPNT",IND,"FILENUM")
. S COMIND(FILENUM,IND)=TYPE
. S UCOM(FILENUM)=""
;Build the component order for display and install.
D CORDER^PXRMEXCO(.UCOM,.NUCMPNT,.COMORDR)
K ^PXD(811.8,IEN,120)
;Set the 0 node.
S ^PXD(811.8,IEN,120,0)=U_"811.802A"_U_NCMPNT_U_NCMPNT
F IND=1:1:NUCMPNT D
. S FILENUM=$O(COMORDR(IND,""))
. S JND="",NITEMS=0
. F S JND=$O(COMIND(FILENUM,JND)) Q:JND="" D
.. S TYPE=COMIND(FILENUM,JND)
.. S NITEMS=NITEMS+1
.. I TYPE="ROUTINE" D
... S TEMP=^TMP($J,"CMPNT",JND,"NAME")_U_^TMP($J,"CMPNT",JND,"START")_U_^TMP($J,"CMPNT",JND,"END")_U_U
... S IOKTI=1,SELECT=0
.. E D
... I FILENUM=811.9 D LRDCHK(IEN,JND,.LRDL)
... S TEMP=^TMP($J,"CMPNT",JND,"NAME")_U_^TMP($J,"CMPNT",JND,"FDA_START")_U_^TMP($J,"CMPNT",JND,"FDA_END")_U_$G(^TMP($J,"CMPNT",JND,"IEN_ROOT_START"))_U_$G(^TMP($J,"CMPNT",JND,"IEN_ROOT_END"))
... S IOKTI=$S(^TMP($J,"CMPNT",JND,"FDA_START")=^TMP($J,"CMPNT",JND,"FDA_END"):0,1:1)
... S SELECT=$S(^TMP($J,"CMPNT",JND,"SELECTED")="YES":1,1:0)
... I FILENUM=801.41,'SELECT S SELECT=$$ISLRD(JND,.LRDL)
.. S TEMP=TEMP_U_IOKTI_U_SELECT
.. S ^PXD(811.8,IEN,120,IND,1,NITEMS,0)=TEMP
. S ^PXD(811.8,IEN,120,IND,0)=TYPE_U_FILENUM_U_NITEMS
. S ^PXD(811.8,IEN,120,IND,1,0)=U_"811.8021A"_U_NITEMS_U_NITEMS
;
;Save the number of component types.
S ^PXD(811.8,IEN,119)=NUCMPNT
K ^TMP($J,"CMPNT")
Q
;
;======================================================
CORDER(UCOM,NUCMPNT,COMORDR) ;Build the component order for
;display and install.
N DOA,IND,FILENUM,RANK
D PACKORD^PXRMEXPD(.RANK)
D ORDER^PXRMEXPD(.UCOM,.RANK,.DOA)
S (IND,NUCMPNT)=0
F S IND=+$O(DOA(IND)) Q:IND=0 D
. S FILENUM=DOA(IND)
. S NUCMPNT=NUCMPNT+1
. S COMORDR(NUCMPNT,FILENUM)=""
Q
;
;======================================================
ISLRD(ITEM,LRDL) ;Return true if this item is a linked reminder
;dialog.
N NAME
S NAME=^TMP($J,"CMPNT",ITEM,"NAME")
Q $S($D(LRDL(NAME)):1,1:0)
;
;======================================================
LRDCHK(IEN,ITEM,LRDL) ;Check reminder definition for a linked reminder
;dialog.
N END,DATA,DONE,FIELD,FNUM,IND,LINE,START
S END=^TMP($J,"CMPNT",ITEM,"FDA_END")
S START=^TMP($J,"CMPNT",ITEM,"FDA_START")
S DONE=0
F IND=START:1:END Q:DONE D
. S LINE=^PXD(811.8,IEN,100,IND,0)
. S FNUM=$P(LINE,";",1)
. S DATA=$P(LINE,";",3)
. S FIELD=$P(DATA,"~",1)
. I FIELD=51 S LRDL($P(DATA,"~",2))="",DONE=1
Q
;
PXRMEXCO ; SLC/PKR/PJH - Exchange File component order. ;03/30/2009
+1 ;;2.0;CLINICAL REMINDERS;**12**;Feb 04, 2005;Build 73
+2 ;======================================================
CLIST(IEN,CLOK) ;Build the list of components for the repository
+1 ;entry IEN.
+2 NEW COMIND,COMORDR,CSTART,CSUM,END,FILENAME,FILENUM
+3 NEW IND,INDEXAT,IOKTI,JND,LINE,LRDL,NCMPNT,NITEMS,NLINES,NUCMPNT
+4 NEW PT01,SELECT,START,TEMP,TAG,TYPE,UCOM,VERSN
+5 SET LINE=^PXD(811.8,IEN,100,1,0)
+6 ;Make sure it is XML version 1.
+7 IF LINE'["<?xml version=""1.0"""
Begin DoDot:1
+8 SET CLOK=0
+9 WRITE !,"Exchange file entry not in proper format!"
+10 HANG 2
End DoDot:1
QUIT
+11 SET LINE=^PXD(811.8,IEN,100,2,0)
+12 IF LINE'="<REMINDER_EXCHANGE_FILE_ENTRY>"
Begin DoDot:1
+13 SET CLOK=0
+14 WRITE !,"Not an Exchange File entry!"
+15 HANG 2
End DoDot:1
QUIT
+16 SET LINE=^PXD(811.8,IEN,100,3,0)
+17 SET VERSN=$$GETTAGV^PXRMEXU3(LINE,"<PACKAGE_VERSION>")
+18 SET LINE=^PXD(811.8,IEN,100,4,0)
+19 SET INDEXAT=+$PIECE(LINE,"<INDEX_AT>",2)
+20 SET LINE=^PXD(811.8,IEN,100,INDEXAT,0)
+21 IF LINE'="<INDEX>"
Begin DoDot:1
+22 SET CLOK=0
+23 WRITE !,"Index missing, cannot continue!"
+24 HANG 2
End DoDot:1
QUIT
+25 SET CLOK=1
+26 KILL ^PXD(811.8,IEN,119),^PXD(811.8,IEN,120)
+27 SET JND=INDEXAT+1
+28 SET LINE=^PXD(811.8,IEN,100,JND,0)
+29 SET NCMPNT=+$$GETTAGV^PXRMEXU3(LINE,"<NUMBER_OF_COMPONENTS>")
+30 KILL ^TMP($JOB,"CMPNT")
+31 FOR IND=1:1:NCMPNT
Begin DoDot:1
+32 KILL END,START
+33 FOR
SET JND=JND+1
SET LINE=^PXD(811.8,IEN,100,JND,0)
IF LINE="</COMPONENT>"
QUIT
Begin DoDot:2
+34 SET TAG=$$GETTAG^PXRMEXU3(LINE)
+35 IF TAG["START"
SET START(TAG)=+$$GETTAGV^PXRMEXU3(LINE,TAG)
+36 IF TAG["END"
SET END(TAG)=+$$GETTAGV^PXRMEXU3(LINE,TAG)
End DoDot:2
+37 IF $DATA(START("<M_ROUTINE_START>"))
Begin DoDot:2
+38 SET CSTART=START("<M_ROUTINE_START>")
+39 SET ^TMP($JOB,"CMPNT",IND,"TYPE")="ROUTINE"
+40 SET LINE=^PXD(811.8,IEN,100,CSTART+1,0)
+41 SET ^TMP($JOB,"CMPNT",IND,"NAME")=$$GETTAGV^PXRMEXU3(LINE,"<ROUTINE_NAME>")
+42 SET ^TMP($JOB,"CMPNT",IND,"FILENUM")=0
+43 ;Save the actual start and end of the code.
+44 SET ^TMP($JOB,"CMPNT",IND,"START")=START("<ROUTINE_CODE_START>")
+45 SET ^TMP($JOB,"CMPNT",IND,"END")=END("<ROUTINE_CODE_END>")
End DoDot:2
+46 IF $DATA(START("<FILE_START>"))
Begin DoDot:2
+47 SET CSTART=START("<FILE_START>")
+48 SET LINE=^PXD(811.8,IEN,100,CSTART+1,0)
+49 SET (^TMP($JOB,"CMPNT",IND,"TYPE"),^TMP($JOB,"CMPNT",IND,"FILENAME"))=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NAME>",1)
+50 SET LINE=^PXD(811.8,IEN,100,CSTART+2,0)
+51 SET ^TMP($JOB,"CMPNT",IND,"FILENUM")=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NUMBER>")
+52 SET LINE=^PXD(811.8,IEN,100,CSTART+3,0)
+53 SET (^TMP($JOB,"CMPNT",IND,"NAME"),^TMP($JOB,"CMPNT",IND,"POINT_01"))=$$GETTAGV^PXRMEXU3(LINE,"<POINT_01>",1)
+54 SET LINE=^PXD(811.8,IEN,100,CSTART+6,0)
+55 SET ^TMP($JOB,"CMPNT",IND,"SELECTED")=$$GETTAGV^PXRMEXU3(LINE,"<SELECTED>")
+56 ;Save the actual start and end of the FileMan FDA.
+57 SET ^TMP($JOB,"CMPNT",IND,"FDA_START")=START("<FDA_START>")
+58 SET ^TMP($JOB,"CMPNT",IND,"FDA_END")=END("<FDA_END>")
+59 SET ^TMP($JOB,"CMPNT",IND,"IEN_ROOT_START")=$GET(START("<IEN_ROOT_START>"))
+60 SET ^TMP($JOB,"CMPNT",IND,"IEN_ROOT_END")=$GET(END("<IEN_ROOT_END>"))
End DoDot:2
End DoDot:1
+61 ;Build some indexes to order the component list.
+62 FOR IND=1:1:NCMPNT
Begin DoDot:1
+63 SET TYPE=^TMP($JOB,"CMPNT",IND,"TYPE")
+64 SET FILENUM=^TMP($JOB,"CMPNT",IND,"FILENUM")
+65 SET COMIND(FILENUM,IND)=TYPE
+66 SET UCOM(FILENUM)=""
End DoDot:1
+67 ;Build the component order for display and install.
+68 DO CORDER^PXRMEXCO(.UCOM,.NUCMPNT,.COMORDR)
+69 KILL ^PXD(811.8,IEN,120)
+70 ;Set the 0 node.
+71 SET ^PXD(811.8,IEN,120,0)=U_"811.802A"_U_NCMPNT_U_NCMPNT
+72 FOR IND=1:1:NUCMPNT
Begin DoDot:1
+73 SET FILENUM=$ORDER(COMORDR(IND,""))
+74 SET JND=""
SET NITEMS=0
+75 FOR
SET JND=$ORDER(COMIND(FILENUM,JND))
IF JND=""
QUIT
Begin DoDot:2
+76 SET TYPE=COMIND(FILENUM,JND)
+77 SET NITEMS=NITEMS+1
+78 IF TYPE="ROUTINE"
Begin DoDot:3
+79 SET TEMP=^TMP($JOB,"CMPNT",JND,"NAME")_U_^TMP($JOB,"CMPNT",JND,"START")_U_^TMP($JOB,"CMPNT",JND,"END")_U_U
+80 SET IOKTI=1
SET SELECT=0
End DoDot:3
+81 IF '$TEST
Begin DoDot:3
+82 IF FILENUM=811.9
DO LRDCHK(IEN,JND,.LRDL)
+83 SET TEMP=^TMP($JOB,"CMPNT",JND,"NAME")_U_^TMP($JOB,"CMPNT",JND,"FDA_START")_U_^TMP($JOB,"CMPNT",JND,"FDA_END")_U_$GET(^TMP($JOB,"CMPNT",JND,"IEN_ROOT_START"))_U_$GET(^TMP($JOB,"CMPNT",JND,"IEN_ROOT_END"))
+84 SET IOKTI=$SELECT(^TMP($JOB,"CMPNT",JND,"FDA_START")=^TMP($JOB,"CMPNT",JND,"FDA_END"):0,1:1)
+85 SET SELECT=$SELECT(^TMP($JOB,"CMPNT",JND,"SELECTED")="YES":1,1:0)
+86 IF FILENUM=801.41
IF 'SELECT
SET SELECT=$$ISLRD(JND,.LRDL)
End DoDot:3
+87 SET TEMP=TEMP_U_IOKTI_U_SELECT
+88 SET ^PXD(811.8,IEN,120,IND,1,NITEMS,0)=TEMP
End DoDot:2
+89 SET ^PXD(811.8,IEN,120,IND,0)=TYPE_U_FILENUM_U_NITEMS
+90 SET ^PXD(811.8,IEN,120,IND,1,0)=U_"811.8021A"_U_NITEMS_U_NITEMS
End DoDot:1
+91 ;
+92 ;Save the number of component types.
+93 SET ^PXD(811.8,IEN,119)=NUCMPNT
+94 KILL ^TMP($JOB,"CMPNT")
+95 QUIT
+96 ;
+97 ;======================================================
CORDER(UCOM,NUCMPNT,COMORDR) ;Build the component order for
+1 ;display and install.
+2 NEW DOA,IND,FILENUM,RANK
+3 DO PACKORD^PXRMEXPD(.RANK)
+4 DO ORDER^PXRMEXPD(.UCOM,.RANK,.DOA)
+5 SET (IND,NUCMPNT)=0
+6 FOR
SET IND=+$ORDER(DOA(IND))
IF IND=0
QUIT
Begin DoDot:1
+7 SET FILENUM=DOA(IND)
+8 SET NUCMPNT=NUCMPNT+1
+9 SET COMORDR(NUCMPNT,FILENUM)=""
End DoDot:1
+10 QUIT
+11 ;
+12 ;======================================================
ISLRD(ITEM,LRDL) ;Return true if this item is a linked reminder
+1 ;dialog.
+2 NEW NAME
+3 SET NAME=^TMP($JOB,"CMPNT",ITEM,"NAME")
+4 QUIT $SELECT($DATA(LRDL(NAME)):1,1:0)
+5 ;
+6 ;======================================================
LRDCHK(IEN,ITEM,LRDL) ;Check reminder definition for a linked reminder
+1 ;dialog.
+2 NEW END,DATA,DONE,FIELD,FNUM,IND,LINE,START
+3 SET END=^TMP($JOB,"CMPNT",ITEM,"FDA_END")
+4 SET START=^TMP($JOB,"CMPNT",ITEM,"FDA_START")
+5 SET DONE=0
+6 FOR IND=START:1:END
IF DONE
QUIT
Begin DoDot:1
+7 SET LINE=^PXD(811.8,IEN,100,IND,0)
+8 SET FNUM=$PIECE(LINE,";",1)
+9 SET DATA=$PIECE(LINE,";",3)
+10 SET FIELD=$PIECE(DATA,"~",1)
+11 IF FIELD=51
SET LRDL($PIECE(DATA,"~",2))=""
SET DONE=1
End DoDot:1
+12 QUIT
+13 ;
