PXRMEXCO ; SLC/PKR/PJH - Exchange File component order. ;04/18/2018
;;2.0;CLINICAL REMINDERS;**12,47,45**;Feb 04, 2005;Build 566
;======================================================
CLIST(IEN,CLOK) ;Build the list of components for the repository
;entry IEN.
K ^TMP($J,"PXRMEX DIALOG")
N COMIND,COMORDR,CSTART,CSUM,END,FILENAME,FILENUM
N IND,INDEXAT,IOKTI,ISDGRP,JND,LINE,LRDL,NCMPNT,NITEMS,NLINES,NUCMPNT
N PT01,SELECT,START,TEMP,TAG,TYPE,UCOM,VERSN,X
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 ISDGRP=$$PATTR^PXRMEXU2(IEN,"GROUPING DIALOG COMPONENTS")
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 !,"The Index is missing cannot continue, running component check to try to find the problem."
. H 2
. D COMPCHK^PXRMEXCC(IEN)
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
.. I FILENUM=801.41,ISDGRP=1 D Q
... S ^TMP($J,"PXRMEX DIALOG","LOC",$P(TEMP,U))=TEMP
... I SELECT S ^TMP($J,"PXRMEX DIALOG","SELECT",$P(TEMP,U))=0
.. S ^PXD(811.8,IEN,120,IND,1,NITEMS,0)=TEMP
. I FILENUM=801.41,ISDGRP=1 Q
. 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
;
I $D(^TMP($J,"PXRMEX DIALOG")),ISDGRP=1 D
.S DCNT=0 D DIALOG(IEN,.DCNT)
.S IND=$O(^PXD(811.8,IEN,120,""),-1)+1
.S NITEMS=0
.S ^PXD(811.8,IEN,120,IND,0)="REMINDER DIALOG^801.41^"_DCNT
.S ^PXD(811.8,IEN,120,IND,1,0)=U_"811.8021A"_U_DCNT_U_DCNT
.S X=0 F S X=$O(^TMP($J,"DIALOG LIST",X)) Q:X'>0 D
..S NITEMS=NITEMS+1,^PXD(811.8,IEN,120,IND,1,NITEMS,0)=^TMP($J,"DIALOG LIST",X)
;Save the number of component types.
S ^PXD(811.8,IEN,119)=NUCMPNT
K ^TMP($J,"CMPNT")
K ^TMP($J,"PXRMEX DIALOG")
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
;
DIALOG(IEN,DCNT) ;
K ^TMP($J,"DIALOG LIST")
N NAME
S NAME="" F S NAME=$O(^TMP($J,"PXRMEX DIALOG","SELECT",NAME)) Q:NAME="" D
.D DIALBLD(IEN,NAME,.DCNT)
Q
;
DIALBLD(IEN,NAME,DCNT) ;
N DATA,DARRAY,END,STRT
S DATA=$G(^TMP($J,"PXRMEX DIALOG","LOC",NAME)) Q:DATA=""
D CHECKCMP(IEN,NAME,DATA,.DCNT)
Q
;
CHECKCMP(IEN,NAME,DATA,DCNT) ;
N CMP,CMPARRAY,DDATA,DEND,DFILE,DFNUM,DIENS,DSTRT,DSUB,DVALUE,SEQ,SORTARR,TEMP
S DSTRT=$P(DATA,U,2),DEND=$P(DATA,U,3)
S DSUB=DSTRT-1
F S DSUB=$O(^PXD(811.8,IEN,100,DSUB)) Q:'DSUB D Q:DSUB>DEND
.S DDATA=$G(^PXD(811.8,IEN,100,DSUB,0)) Q:DDATA=""
.S DFILE=$P(DDATA,";"),DIENS=$P(DDATA,";",2),DFNUM=$P(DDATA,";",3)
.Q:DFILE="" Q:DIENS="" Q:DFNUM=""
.S DVALUE=$P(DFNUM,"~",2),DFNUM=$P(DFNUM,"~")
.Q:DFNUM=""
.I DFILE'=801.41 S CMPARRAY(DFILE,DIENS,DFNUM)=DVALUE
.;check branching logic
.I DFILE=801.41143,DFNUM=4 D
..S TEMP=$G(^TMP($J,"PXRMEX DIALOG","LOC",DVALUE))
..D CHECKCMP(IEN,DVALUE,TEMP,.DCNT)
.I DFNUM=118 D
..S TEMP=$G(^TMP($J,"PXRMEX DIALOG","LOC",DVALUE))
..D CHECKCMP(IEN,DVALUE,TEMP,.DCNT)
;
;check result groups list
I $D(CMPARRAY(801.41121)) D
.S DIENS="" F S DIENS=$O(CMPARRAY(801.41121,DIENS)) Q:DIENS="" D
..S CMP=CMPARRAY(801.41121,DIENS,.01)
..S TEMP=$G(^TMP($J,"PXRMEX DIALOG","LOC",CMP))
..D CHECKCMP(IEN,CMP,TEMP,.DCNT)
;
;check components
I $D(CMPARRAY(801.412)) D
.S DIENS="" F S DIENS=$O(CMPARRAY(801.412,DIENS)) Q:DIENS="" D
..S SEQ=CMPARRAY(801.412,DIENS,.01),CMP=CMPARRAY(801.412,DIENS,2)
..S SORTARR(SEQ)=CMP
.S SEQ=0 F S SEQ=$O(SORTARR(SEQ)) Q:SEQ'>0 D
..S CMP=SORTARR(SEQ)
..S TEMP=$G(^TMP($J,"PXRMEX DIALOG","LOC",CMP))
..D CHECKCMP(IEN,CMP,TEMP,.DCNT)
;
I $D(^TMP($J,"PXRMEX DIALOG","SELECT",NAME)) D
.I ^TMP($J,"PXRMEX DIALOG","SELECT",NAME)=1 S $P(DATA,U,7)=0 Q
.S ^TMP($J,"PXRMEX DIALOG","SELECT",NAME)=1
S DCNT=DCNT+1,^TMP($J,"DIALOG LIST",DCNT)=DATA
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXCO 8201 printed Apr 09, 2024@20:51:41 Page 2
PXRMEXCO ; SLC/PKR/PJH - Exchange File component order. ;04/18/2018
+1 ;;2.0;CLINICAL REMINDERS;**12,47,45**;Feb 04, 2005;Build 566
+2 ;======================================================
CLIST(IEN,CLOK) ;Build the list of components for the repository
+1 ;entry IEN.
+2 KILL ^TMP($JOB,"PXRMEX DIALOG")
+3 NEW COMIND,COMORDR,CSTART,CSUM,END,FILENAME,FILENUM
+4 NEW IND,INDEXAT,IOKTI,ISDGRP,JND,LINE,LRDL,NCMPNT,NITEMS,NLINES,NUCMPNT
+5 NEW PT01,SELECT,START,TEMP,TAG,TYPE,UCOM,VERSN,X
+6 SET LINE=^PXD(811.8,IEN,100,1,0)
+7 ;Make sure it is XML version 1.
+8 IF LINE'["<?xml version=""1.0"""
Begin DoDot:1
+9 SET CLOK=0
+10 WRITE !,"Exchange file entry not in proper format!"
+11 HANG 2
End DoDot:1
QUIT
+12 SET LINE=^PXD(811.8,IEN,100,2,0)
+13 IF LINE'="<REMINDER_EXCHANGE_FILE_ENTRY>"
Begin DoDot:1
+14 SET CLOK=0
+15 WRITE !,"Not an Exchange File entry!"
+16 HANG 2
End DoDot:1
QUIT
+17 SET LINE=^PXD(811.8,IEN,100,3,0)
+18 SET VERSN=$$GETTAGV^PXRMEXU3(LINE,"<PACKAGE_VERSION>")
+19 SET ISDGRP=$$PATTR^PXRMEXU2(IEN,"GROUPING DIALOG COMPONENTS")
+20 SET LINE=^PXD(811.8,IEN,100,4,0)
+21 SET INDEXAT=+$PIECE(LINE,"<INDEX_AT>",2)
+22 SET LINE=^PXD(811.8,IEN,100,INDEXAT,0)
+23 IF LINE'="<INDEX>"
Begin DoDot:1
+24 SET CLOK=0
+25 WRITE !,"The Index is missing cannot continue, running component check to try to find the problem."
+26 HANG 2
+27 DO COMPCHK^PXRMEXCC(IEN)
End DoDot:1
QUIT
+28 SET CLOK=1
+29 KILL ^PXD(811.8,IEN,119),^PXD(811.8,IEN,120)
+30 SET JND=INDEXAT+1
+31 SET LINE=^PXD(811.8,IEN,100,JND,0)
+32 SET NCMPNT=+$$GETTAGV^PXRMEXU3(LINE,"<NUMBER_OF_COMPONENTS>")
+33 KILL ^TMP($JOB,"CMPNT")
+34 FOR IND=1:1:NCMPNT
Begin DoDot:1
+35 KILL END,START
+36 FOR
SET JND=JND+1
SET LINE=^PXD(811.8,IEN,100,JND,0)
if LINE="</COMPONENT>"
QUIT
Begin DoDot:2
+37 SET TAG=$$GETTAG^PXRMEXU3(LINE)
+38 IF TAG["START"
SET START(TAG)=+$$GETTAGV^PXRMEXU3(LINE,TAG)
+39 IF TAG["END"
SET END(TAG)=+$$GETTAGV^PXRMEXU3(LINE,TAG)
End DoDot:2
+40 IF $DATA(START("<M_ROUTINE_START>"))
Begin DoDot:2
+41 SET CSTART=START("<M_ROUTINE_START>")
+42 SET ^TMP($JOB,"CMPNT",IND,"TYPE")="ROUTINE"
+43 SET LINE=^PXD(811.8,IEN,100,CSTART+1,0)
+44 SET ^TMP($JOB,"CMPNT",IND,"NAME")=$$GETTAGV^PXRMEXU3(LINE,"<ROUTINE_NAME>")
+45 SET ^TMP($JOB,"CMPNT",IND,"FILENUM")=0
+46 ;Save the actual start and end of the code.
+47 SET ^TMP($JOB,"CMPNT",IND,"START")=START("<ROUTINE_CODE_START>")
+48 SET ^TMP($JOB,"CMPNT",IND,"END")=END("<ROUTINE_CODE_END>")
End DoDot:2
+49 IF $DATA(START("<FILE_START>"))
Begin DoDot:2
+50 SET CSTART=START("<FILE_START>")
+51 SET LINE=^PXD(811.8,IEN,100,CSTART+1,0)
+52 SET (^TMP($JOB,"CMPNT",IND,"TYPE"),^TMP($JOB,"CMPNT",IND,"FILENAME"))=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NAME>",1)
+53 SET LINE=^PXD(811.8,IEN,100,CSTART+2,0)
+54 SET ^TMP($JOB,"CMPNT",IND,"FILENUM")=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NUMBER>")
+55 SET LINE=^PXD(811.8,IEN,100,CSTART+3,0)
+56 SET (^TMP($JOB,"CMPNT",IND,"NAME"),^TMP($JOB,"CMPNT",IND,"POINT_01"))=$$GETTAGV^PXRMEXU3(LINE,"<POINT_01>",1)
+57 SET LINE=^PXD(811.8,IEN,100,CSTART+6,0)
+58 SET ^TMP($JOB,"CMPNT",IND,"SELECTED")=$$GETTAGV^PXRMEXU3(LINE,"<SELECTED>")
+59 ;Save the actual start and end of the FileMan FDA.
+60 SET ^TMP($JOB,"CMPNT",IND,"FDA_START")=START("<FDA_START>")
+61 SET ^TMP($JOB,"CMPNT",IND,"FDA_END")=END("<FDA_END>")
+62 SET ^TMP($JOB,"CMPNT",IND,"IEN_ROOT_START")=$GET(START("<IEN_ROOT_START>"))
+63 SET ^TMP($JOB,"CMPNT",IND,"IEN_ROOT_END")=$GET(END("<IEN_ROOT_END>"))
End DoDot:2
End DoDot:1
+64 ;Build some indexes to order the component list.
+65 FOR IND=1:1:NCMPNT
Begin DoDot:1
+66 SET TYPE=^TMP($JOB,"CMPNT",IND,"TYPE")
+67 SET FILENUM=^TMP($JOB,"CMPNT",IND,"FILENUM")
+68 SET COMIND(FILENUM,IND)=TYPE
+69 SET UCOM(FILENUM)=""
End DoDot:1
+70 ;Build the component order for display and install.
+71 DO CORDER^PXRMEXCO(.UCOM,.NUCMPNT,.COMORDR)
+72 KILL ^PXD(811.8,IEN,120)
+73 ;Set the 0 node.
+74 SET ^PXD(811.8,IEN,120,0)=U_"811.802A"_U_NCMPNT_U_NCMPNT
+75 FOR IND=1:1:NUCMPNT
Begin DoDot:1
+76 SET FILENUM=$ORDER(COMORDR(IND,""))
+77 SET JND=""
SET NITEMS=0
+78 FOR
SET JND=$ORDER(COMIND(FILENUM,JND))
if JND=""
QUIT
Begin DoDot:2
+79 SET TYPE=COMIND(FILENUM,JND)
+80 SET NITEMS=NITEMS+1
+81 IF TYPE="ROUTINE"
Begin DoDot:3
+82 SET TEMP=^TMP($JOB,"CMPNT",JND,"NAME")_U_^TMP($JOB,"CMPNT",JND,"START")_U_^TMP($JOB,"CMPNT",JND,"END")_U_U
+83 SET IOKTI=1
SET SELECT=0
End DoDot:3
+84 IF '$TEST
Begin DoDot:3
+85 IF FILENUM=811.9
DO LRDCHK(IEN,JND,.LRDL)
+86 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"))
+87 SET IOKTI=$SELECT(^TMP($JOB,"CMPNT",JND,"FDA_START")=^TMP($JOB,"CMPNT",JND,"FDA_END"):0,1:1)
+88 SET SELECT=$SELECT(^TMP($JOB,"CMPNT",JND,"SELECTED")="YES":1,1:0)
+89 IF FILENUM=801.41
IF 'SELECT
SET SELECT=$$ISLRD(JND,.LRDL)
End DoDot:3
+90 SET TEMP=TEMP_U_IOKTI_U_SELECT
+91 IF FILENUM=801.41
IF ISDGRP=1
Begin DoDot:3
+92 SET ^TMP($JOB,"PXRMEX DIALOG","LOC",$PIECE(TEMP,U))=TEMP
+93 IF SELECT
SET ^TMP($JOB,"PXRMEX DIALOG","SELECT",$PIECE(TEMP,U))=0
End DoDot:3
QUIT
+94 SET ^PXD(811.8,IEN,120,IND,1,NITEMS,0)=TEMP
End DoDot:2
+95 IF FILENUM=801.41
IF ISDGRP=1
QUIT
+96 SET ^PXD(811.8,IEN,120,IND,0)=TYPE_U_FILENUM_U_NITEMS
+97 SET ^PXD(811.8,IEN,120,IND,1,0)=U_"811.8021A"_U_NITEMS_U_NITEMS
End DoDot:1
+98 ;
+99 IF $DATA(^TMP($JOB,"PXRMEX DIALOG"))
IF ISDGRP=1
Begin DoDot:1
+100 SET DCNT=0
DO DIALOG(IEN,.DCNT)
+101 SET IND=$ORDER(^PXD(811.8,IEN,120,""),-1)+1
+102 SET NITEMS=0
+103 SET ^PXD(811.8,IEN,120,IND,0)="REMINDER DIALOG^801.41^"_DCNT
+104 SET ^PXD(811.8,IEN,120,IND,1,0)=U_"811.8021A"_U_DCNT_U_DCNT
+105 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"DIALOG LIST",X))
if X'>0
QUIT
Begin DoDot:2
+106 SET NITEMS=NITEMS+1
SET ^PXD(811.8,IEN,120,IND,1,NITEMS,0)=^TMP($JOB,"DIALOG LIST",X)
End DoDot:2
End DoDot:1
+107 ;Save the number of component types.
+108 SET ^PXD(811.8,IEN,119)=NUCMPNT
+109 KILL ^TMP($JOB,"CMPNT")
+110 KILL ^TMP($JOB,"PXRMEX DIALOG")
+111 QUIT
+112 ;
+113 ;======================================================
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 ;
DIALOG(IEN,DCNT) ;
+1 KILL ^TMP($JOB,"DIALOG LIST")
+2 NEW NAME
+3 SET NAME=""
FOR
SET NAME=$ORDER(^TMP($JOB,"PXRMEX DIALOG","SELECT",NAME))
if NAME=""
QUIT
Begin DoDot:1
+4 DO DIALBLD(IEN,NAME,.DCNT)
End DoDot:1
+5 QUIT
+6 ;
DIALBLD(IEN,NAME,DCNT) ;
+1 NEW DATA,DARRAY,END,STRT
+2 SET DATA=$GET(^TMP($JOB,"PXRMEX DIALOG","LOC",NAME))
if DATA=""
QUIT
+3 DO CHECKCMP(IEN,NAME,DATA,.DCNT)
+4 QUIT
+5 ;
CHECKCMP(IEN,NAME,DATA,DCNT) ;
+1 NEW CMP,CMPARRAY,DDATA,DEND,DFILE,DFNUM,DIENS,DSTRT,DSUB,DVALUE,SEQ,SORTARR,TEMP
+2 SET DSTRT=$PIECE(DATA,U,2)
SET DEND=$PIECE(DATA,U,3)
+3 SET DSUB=DSTRT-1
+4 FOR
SET DSUB=$ORDER(^PXD(811.8,IEN,100,DSUB))
if 'DSUB
QUIT
Begin DoDot:1
+5 SET DDATA=$GET(^PXD(811.8,IEN,100,DSUB,0))
if DDATA=""
QUIT
+6 SET DFILE=$PIECE(DDATA,";")
SET DIENS=$PIECE(DDATA,";",2)
SET DFNUM=$PIECE(DDATA,";",3)
+7 if DFILE=""
QUIT
if DIENS=""
QUIT
if DFNUM=""
QUIT
+8 SET DVALUE=$PIECE(DFNUM,"~",2)
SET DFNUM=$PIECE(DFNUM,"~")
+9 if DFNUM=""
QUIT
+10 IF DFILE'=801.41
SET CMPARRAY(DFILE,DIENS,DFNUM)=DVALUE
+11 ;check branching logic
+12 IF DFILE=801.41143
IF DFNUM=4
Begin DoDot:2
+13 SET TEMP=$GET(^TMP($JOB,"PXRMEX DIALOG","LOC",DVALUE))
+14 DO CHECKCMP(IEN,DVALUE,TEMP,.DCNT)
End DoDot:2
+15 IF DFNUM=118
Begin DoDot:2
+16 SET TEMP=$GET(^TMP($JOB,"PXRMEX DIALOG","LOC",DVALUE))
+17 DO CHECKCMP(IEN,DVALUE,TEMP,.DCNT)
End DoDot:2
End DoDot:1
if DSUB>DEND
QUIT
+18 ;
+19 ;check result groups list
+20 IF $DATA(CMPARRAY(801.41121))
Begin DoDot:1
+21 SET DIENS=""
FOR
SET DIENS=$ORDER(CMPARRAY(801.41121,DIENS))
if DIENS=""
QUIT
Begin DoDot:2
+22 SET CMP=CMPARRAY(801.41121,DIENS,.01)
+23 SET TEMP=$GET(^TMP($JOB,"PXRMEX DIALOG","LOC",CMP))
+24 DO CHECKCMP(IEN,CMP,TEMP,.DCNT)
End DoDot:2
End DoDot:1
+25 ;
+26 ;check components
+27 IF $DATA(CMPARRAY(801.412))
Begin DoDot:1
+28 SET DIENS=""
FOR
SET DIENS=$ORDER(CMPARRAY(801.412,DIENS))
if DIENS=""
QUIT
Begin DoDot:2
+29 SET SEQ=CMPARRAY(801.412,DIENS,.01)
SET CMP=CMPARRAY(801.412,DIENS,2)
+30 SET SORTARR(SEQ)=CMP
End DoDot:2
+31 SET SEQ=0
FOR
SET SEQ=$ORDER(SORTARR(SEQ))
if SEQ'>0
QUIT
Begin DoDot:2
+32 SET CMP=SORTARR(SEQ)
+33 SET TEMP=$GET(^TMP($JOB,"PXRMEX DIALOG","LOC",CMP))
+34 DO CHECKCMP(IEN,CMP,TEMP,.DCNT)
End DoDot:2
End DoDot:1
+35 ;
+36 IF $DATA(^TMP($JOB,"PXRMEX DIALOG","SELECT",NAME))
Begin DoDot:1
+37 IF ^TMP($JOB,"PXRMEX DIALOG","SELECT",NAME)=1
SET $PIECE(DATA,U,7)=0
QUIT
+38 SET ^TMP($JOB,"PXRMEX DIALOG","SELECT",NAME)=1
End DoDot:1
+39 SET DCNT=DCNT+1
SET ^TMP($JOB,"DIALOG LIST",DCNT)=DATA
+40 QUIT
+41 ;======================================================
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 ;
