PXRMEXSI ;SLC/PKR/PJH - Silent Exchange entry install. ;04/19/2012
;;2.0;CLINICAL REMINDERS;**6,12,17,18,24**;Feb 04, 2005;Build 193
;
;=======================================
DELEXE(ENTRY,ROUTINE) ;If the Exchange File entry already exists delete it.
N EXARRAY,IC,IND,LIST,LUVALUE,NUM
D LDARRAY^PXRMEXSI("L",ENTRY,ROUTINE,.EXARRAY)
S IC=0
F S IC=$O(EXARRAY(IC)) Q:'IC D
. S LUVALUE(1)=EXARRAY(IC,1)
. D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
. I '$D(LIST) Q
. S NUM=$P(LIST("DILIST",0),U,1)
. I NUM'=0 D
.. F IND=1:1:NUM D
... N DA,DIK
... S DIK="^PXD(811.8,"
... S DA=LIST("DILIST",2,IND)
... D ^DIK
Q
;
;=======================================
EXFINC(Y,ENTRY,ROUTINE) ;Return a 1 if the Exchange file entry is in the list
;to include in the build. This is used in the build to determine which
;entries to include.
N EXARRAY,FOUND,IEN,IC,LUVALUE
D LDARRAY^PXRMEXSI("I",ENTRY,ROUTINE,.EXARRAY)
S FOUND=0
S IC=0
F S IC=+$O(EXARRAY(IC)) Q:(IC=0)!(FOUND) D
. M LUVALUE=EXARRAY(IC)
. S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
. I IEN=Y S FOUND=1 Q
Q FOUND
;
;=======================================
INSCOM(PXRMRIEN,ACTION,IND,TEMP,HISTSUB) ;Install component IND
;of PXRMRIEN.
N ATTR,CSUM,END,EXISTS,FILENUM,IND120,JND120,NAME
N PT01,RTN,SAME,START,TEXT
S FILENUM=$P(TEMP,U,1),EXISTS=$P(TEMP,U,4)
S IND120=$P(TEMP,U,2),JND120=$P(TEMP,U,3)
I (IND120="")!(JND120="") Q
S TEMP=^PXD(811.8,PXRMRIEN,120,IND120,1,JND120,0)
;If the component does not exist then the action has to be "I".
;If the component exists and the action is "I" change it to "O".
;Otherwise leave the action as is.
S ACTION=$S('EXISTS:"I",ACTION="I":"O",1:ACTION)
S SAME=0
S START=$P(TEMP,U,2)
S END=$P(TEMP,U,3)
I FILENUM=0 D
. D RTNLD^PXRMEXIC(PXRMRIEN,START,END,.ATTR,.RTN)
. I EXISTS D
.. D CHECKSUM^PXRMEXCS(.ATTR,START,END)
.. S CSUM=$$RTNCS^PXRMEXCS(ATTR("NAME"))
.. I ATTR("CHECKSUM")=CSUM S SAME=1,ACTION="S"
. S ^TMP("PXRMEXIA",$J,IND,"ROUTINE",ATTR("NAME"),ACTION)=""
E D
. S TEMP=^PXD(811.8,PXRMRIEN,100,START,0)
. S PT01=$P(TEMP,"~",2)
.;Save reminder name for dialog install.
. ;I FILENUM=811.9 S REMNAME=PT01
. D SETATTR^PXRMEXFI(.ATTR,FILENUM,PT01)
. I EXISTS D
.. D CHECKSUM^PXRMEXCS(.ATTR,START,END)
.. S CSUM=$$FILE^PXRMEXCS(ATTR("FILE NUMBER"),EXISTS)
.. I ATTR("CHECKSUM")=CSUM S SAME=1,ACTION="S"
.;Save what was done for the installation summary.
. S ^TMP(HISTSUB,$J,IND,ATTR("FILE NAME"),PT01,ACTION)=""
;If the packed component and the installed component are the same
;there is nothing to do.
I SAME Q
;Install this component.
I FILENUM=0 D RTNSAVE^PXRMEXIC(.RTN,ATTR("NAME"))
E D FILE^PXRMEXIC(PXRMRIEN,EXISTS,IND120,JND120,ACTION,.ATTR,.PXRMNMCH)
Q
;
;=======================================
INSDLG(PXRMRIEN,IND120,JND120,ACTION) ;Install dialog components directly
;from the "SEL" array.
N IND,FILENUM,ITEMP,NAME,TEMP
;Build the selection array in ^TMP("PXRMEXLD",$J,"SEL"). For dialogs
;the selection array is:
;file no.^FDA start^FDA end^EXISTS^IND120^JND120^NAME
S FILENUM=801.41
D DBUILD^PXRMEXLB(PXRMRIEN,IND120,JND120)
D BLDDISP^PXRMEXDB(0)
;Work through the selection array installing the dialog parts
;in reverse order.
S IND=""
F S IND=$O(^TMP("PXRMEXLD",$J,"SEL",IND),-1) Q:(IND="")!(PXRMDONE) D
. S TEMP=^TMP("PXRMEXLD",$J,"SEL",IND)
. S FILENUM=$P(TEMP,U,1),NAME=$P(TEMP,U,7)
.;Dialog elements may be used more than once in a dialog so make sure
.;the element has not already been installed.
. S ITEMP=$P(TEMP,U,1)_U_$P(TEMP,U,4,5)_U_$$EXISTS^PXRMEXIU(FILENUM,NAME)
. D INSCOM(PXRMRIEN,ACTION,IND,ITEMP,"PXRMEXIAD")
Q
;
;=======================================
INSTALL(PXRMRIEN,ACTION,NOCF,NOR) ;Install all components in a repository entry.
;If NOCF is true do not install computed findings, if NOR is true
;do not install routines.
N CLOK,DNAME,FILENUM,IND,PXRMDONE,PXRMNMCH,REMNAME,TEMP,RNAME
S PXRMDONE=0
S NOCF=$G(NOCF),NOR=$G(NOR)
;Initialize ^TMP globals.
D INITMPG^PXRMEXLM
;Build the component list.
K ^PXD(811.8,PXRMRIEN,100,"B")
K ^PXD(811.8,PXRMRIEN,120)
D CLIST^PXRMEXCO(PXRMRIEN,.CLOK)
I 'CLOK Q
;Build the selectable list.
D CDISP^PXRMEXLC(PXRMRIEN)
;Set the install type.
S ^TMP("PXRMEXIA",$J,"TYPE")="SILENT"
;Initialize the name change storage.
K PXRMNMCH
S IND=0
F S IND=$O(^TMP("PXRMEXLC",$J,"SEL",IND)) Q:(IND="")!(PXRMDONE) D
. S TEMP=^TMP("PXRMEXLC",$J,"SEL",IND)
. S FILENUM=$P(TEMP,U,1)
.;If NOCF is true do not install computed findings.
. I FILENUM=811.4,NOCF Q
.;If NOR is true do not install routines.
. I FILENUM=0,NOR Q
. ;Install dialog components
. I FILENUM=801.41 D Q
.. N IND120,JND120,PXRMDONE
.. S IND120=$P(TEMP,U,2),JND120=$P(TEMP,U,3),PXRMDONE=0
.. D INSDLG(PXRMRIEN,IND120,JND120,ACTION)
. ;Install component
. E D INSCOM(PXRMRIEN,ACTION,IND,TEMP,"PXRMEXIA")
;
;Get the dialog name
S DNAME="" F S DNAME=$O(^TMP("PXRMEXDL",$J,DNAME)) Q:DNAME="" D
. S RNAME=""
. F S RNAME=$O(^TMP("PXRMEXDL",$J,DNAME,RNAME)) Q:RNAME="" D
..;Link the dialog if it exists
.. N DIEN,RIEN
..;Get the dialog ien.
.. S DIEN=$$EXISTS^PXRMEXIU(801.41,DNAME) Q:'DIEN
..;Get the reminder ien.
.. S RIEN=+$$EXISTS^PXRMEXIU(811.9,$G(RNAME)) Q:'RIEN
.. N DA,DIE,DIK,DR
..;Set reminder to dialog pointer.
.. S DR="51///^S X=DNAME",DIE="^PXD(811.9,",DA=RIEN
.. D ^DIE
;
;Save the install history.
D SAVHIST^PXRMEXU1
;If any components were skipped send the message.
I $D(^TMP("PXRMEXNI",$J)) D
. N NE,XMSUB
. S NE=$O(^TMP("PXRMEXNI",$J,""),-1)+1
. S ^TMP("PXRMEXNI",$J,NE,0)="Please review and make changes as necessary."
. K ^TMP("PXRMXMZ",$J)
. M ^TMP("PXRMXMZ",$J)=^TMP("PXRMEXNI",$J)
. S XMSUB="COMPONENTS SKIPPED DURING SILENT MODE INSTALL"
. D SEND^PXRMMSG("PXRMXMZ",XMSUB,"",DUZ)
;Cleanup TMP globals.
D INITMPG^PXRMEXLM
Q
;
;=======================================
LDARRAY(MODE,ENTRY,ROUTINE,ARRAY) ;Load ARRAY with
;MODE is a string that may contain any of the following:
; A = include action, stored in the third column of the ARRAY entry.
; I = include in build, used for the data screen in the KIDS build.
; If MODE contains I then the date and time are stored in the second
; column of the ARRAY entry.
; L = load action, store the name in the first column of the ARRAY
; entry. This is the default and both A and I imply L.
;ENTRY is the entry point in ROUTINE which is called to populate
;ARRAY.
N RTN
S RTN=ENTRY_"^"_ROUTINE_"(MODE,.ARRAY)"
D @RTN
Q
;
;=======================================
SMEXINS(ENTRY,ROUTINE) ;Silent mode install.
N ACTION,EXARRAY,FMTSTR,IC,IEN,LUVALUE,NOUT,NTI,PXRMINST,TEXT,TEXTOUT
S PXRMINST=1
D LDARRAY^PXRMEXSI("IA",ENTRY,ROUTINE,.EXARRAY)
S NTI=$O(EXARRAY(""),-1),NTI=$L(NTI)+1
S FMTSTR=NTI_"R1^"_(77-NTI)_"L"
S IC=0
F S IC=$O(EXARRAY(IC)) Q:'IC D
. S LUVALUE(1)=EXARRAY(IC,1),LUVALUE(2)=EXARRAY(IC,2)
. S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
. I IEN=0 Q
. S TEXT=IC_".^Installing Reminder Exchange entry "_LUVALUE(1)
. K TEXTOUT
. D COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NOUT,.TEXTOUT)
. D MES^XPDUTL(.TEXTOUT)
. S ACTION=EXARRAY(IC,3)
. D INSTALL^PXRMEXSI(IEN,ACTION,1,1)
Q
;
PXRMEXSI ;SLC/PKR/PJH - Silent Exchange entry install. ;04/19/2012
+1 ;;2.0;CLINICAL REMINDERS;**6,12,17,18,24**;Feb 04, 2005;Build 193
+2 ;
+3 ;=======================================
DELEXE(ENTRY,ROUTINE) ;If the Exchange File entry already exists delete it.
+1 NEW EXARRAY,IC,IND,LIST,LUVALUE,NUM
+2 DO LDARRAY^PXRMEXSI("L",ENTRY,ROUTINE,.EXARRAY)
+3 SET IC=0
+4 FOR
SET IC=$ORDER(EXARRAY(IC))
IF 'IC
QUIT
Begin DoDot:1
+5 SET LUVALUE(1)=EXARRAY(IC,1)
+6 DO FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
+7 IF '$DATA(LIST)
QUIT
+8 SET NUM=$PIECE(LIST("DILIST",0),U,1)
+9 IF NUM'=0
Begin DoDot:2
+10 FOR IND=1:1:NUM
Begin DoDot:3
+11 NEW DA,DIK
+12 SET DIK="^PXD(811.8,"
+13 SET DA=LIST("DILIST",2,IND)
+14 DO ^DIK
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
+17 ;=======================================
EXFINC(Y,ENTRY,ROUTINE) ;Return a 1 if the Exchange file entry is in the list
+1 ;to include in the build. This is used in the build to determine which
+2 ;entries to include.
+3 NEW EXARRAY,FOUND,IEN,IC,LUVALUE
+4 DO LDARRAY^PXRMEXSI("I",ENTRY,ROUTINE,.EXARRAY)
+5 SET FOUND=0
+6 SET IC=0
+7 FOR
SET IC=+$ORDER(EXARRAY(IC))
IF (IC=0)!(FOUND)
QUIT
Begin DoDot:1
+8 MERGE LUVALUE=EXARRAY(IC)
+9 SET IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
+10 IF IEN=Y
SET FOUND=1
QUIT
End DoDot:1
+11 QUIT FOUND
+12 ;
+13 ;=======================================
INSCOM(PXRMRIEN,ACTION,IND,TEMP,HISTSUB) ;Install component IND
+1 ;of PXRMRIEN.
+2 NEW ATTR,CSUM,END,EXISTS,FILENUM,IND120,JND120,NAME
+3 NEW PT01,RTN,SAME,START,TEXT
+4 SET FILENUM=$PIECE(TEMP,U,1)
SET EXISTS=$PIECE(TEMP,U,4)
+5 SET IND120=$PIECE(TEMP,U,2)
SET JND120=$PIECE(TEMP,U,3)
+6 IF (IND120="")!(JND120="")
QUIT
+7 SET TEMP=^PXD(811.8,PXRMRIEN,120,IND120,1,JND120,0)
+8 ;If the component does not exist then the action has to be "I".
+9 ;If the component exists and the action is "I" change it to "O".
+10 ;Otherwise leave the action as is.
+11 SET ACTION=$SELECT('EXISTS:"I",ACTION="I":"O",1:ACTION)
+12 SET SAME=0
+13 SET START=$PIECE(TEMP,U,2)
+14 SET END=$PIECE(TEMP,U,3)
+15 IF FILENUM=0
Begin DoDot:1
+16 DO RTNLD^PXRMEXIC(PXRMRIEN,START,END,.ATTR,.RTN)
+17 IF EXISTS
Begin DoDot:2
+18 DO CHECKSUM^PXRMEXCS(.ATTR,START,END)
+19 SET CSUM=$$RTNCS^PXRMEXCS(ATTR("NAME"))
+20 IF ATTR("CHECKSUM")=CSUM
SET SAME=1
SET ACTION="S"
End DoDot:2
+21 SET ^TMP("PXRMEXIA",$JOB,IND,"ROUTINE",ATTR("NAME"),ACTION)=""
End DoDot:1
+22 IF '$TEST
Begin DoDot:1
+23 SET TEMP=^PXD(811.8,PXRMRIEN,100,START,0)
+24 SET PT01=$PIECE(TEMP,"~",2)
+25 ;Save reminder name for dialog install.
+26 ;I FILENUM=811.9 S REMNAME=PT01
+27 DO SETATTR^PXRMEXFI(.ATTR,FILENUM,PT01)
+28 IF EXISTS
Begin DoDot:2
+29 DO CHECKSUM^PXRMEXCS(.ATTR,START,END)
+30 SET CSUM=$$FILE^PXRMEXCS(ATTR("FILE NUMBER"),EXISTS)
+31 IF ATTR("CHECKSUM")=CSUM
SET SAME=1
SET ACTION="S"
End DoDot:2
+32 ;Save what was done for the installation summary.
+33 SET ^TMP(HISTSUB,$JOB,IND,ATTR("FILE NAME"),PT01,ACTION)=""
End DoDot:1
+34 ;If the packed component and the installed component are the same
+35 ;there is nothing to do.
+36 IF SAME
QUIT
+37 ;Install this component.
+38 IF FILENUM=0
DO RTNSAVE^PXRMEXIC(.RTN,ATTR("NAME"))
+39 IF '$TEST
DO FILE^PXRMEXIC(PXRMRIEN,EXISTS,IND120,JND120,ACTION,.ATTR,.PXRMNMCH)
+40 QUIT
+41 ;
+42 ;=======================================
INSDLG(PXRMRIEN,IND120,JND120,ACTION) ;Install dialog components directly
+1 ;from the "SEL" array.
+2 NEW IND,FILENUM,ITEMP,NAME,TEMP
+3 ;Build the selection array in ^TMP("PXRMEXLD",$J,"SEL"). For dialogs
+4 ;the selection array is:
+5 ;file no.^FDA start^FDA end^EXISTS^IND120^JND120^NAME
+6 SET FILENUM=801.41
+7 DO DBUILD^PXRMEXLB(PXRMRIEN,IND120,JND120)
+8 DO BLDDISP^PXRMEXDB(0)
+9 ;Work through the selection array installing the dialog parts
+10 ;in reverse order.
+11 SET IND=""
+12 FOR
SET IND=$ORDER(^TMP("PXRMEXLD",$JOB,"SEL",IND),-1)
IF (IND="")!(PXRMDONE)
QUIT
Begin DoDot:1
+13 SET TEMP=^TMP("PXRMEXLD",$JOB,"SEL",IND)
+14 SET FILENUM=$PIECE(TEMP,U,1)
SET NAME=$PIECE(TEMP,U,7)
+15 ;Dialog elements may be used more than once in a dialog so make sure
+16 ;the element has not already been installed.
+17 SET ITEMP=$PIECE(TEMP,U,1)_U_$PIECE(TEMP,U,4,5)_U_$$EXISTS^PXRMEXIU(FILENUM,NAME)
+18 DO INSCOM(PXRMRIEN,ACTION,IND,ITEMP,"PXRMEXIAD")
End DoDot:1
+19 QUIT
+20 ;
+21 ;=======================================
INSTALL(PXRMRIEN,ACTION,NOCF,NOR) ;Install all components in a repository entry.
+1 ;If NOCF is true do not install computed findings, if NOR is true
+2 ;do not install routines.
+3 NEW CLOK,DNAME,FILENUM,IND,PXRMDONE,PXRMNMCH,REMNAME,TEMP,RNAME
+4 SET PXRMDONE=0
+5 SET NOCF=$GET(NOCF)
SET NOR=$GET(NOR)
+6 ;Initialize ^TMP globals.
+7 DO INITMPG^PXRMEXLM
+8 ;Build the component list.
+9 KILL ^PXD(811.8,PXRMRIEN,100,"B")
+10 KILL ^PXD(811.8,PXRMRIEN,120)
+11 DO CLIST^PXRMEXCO(PXRMRIEN,.CLOK)
+12 IF 'CLOK
QUIT
+13 ;Build the selectable list.
+14 DO CDISP^PXRMEXLC(PXRMRIEN)
+15 ;Set the install type.
+16 SET ^TMP("PXRMEXIA",$JOB,"TYPE")="SILENT"
+17 ;Initialize the name change storage.
+18 KILL PXRMNMCH
+19 SET IND=0
+20 FOR
SET IND=$ORDER(^TMP("PXRMEXLC",$JOB,"SEL",IND))
IF (IND="")!(PXRMDONE)
QUIT
Begin DoDot:1
+21 SET TEMP=^TMP("PXRMEXLC",$JOB,"SEL",IND)
+22 SET FILENUM=$PIECE(TEMP,U,1)
+23 ;If NOCF is true do not install computed findings.
+24 IF FILENUM=811.4
IF NOCF
QUIT
+25 ;If NOR is true do not install routines.
+26 IF FILENUM=0
IF NOR
QUIT
+27 ;Install dialog components
+28 IF FILENUM=801.41
Begin DoDot:2
+29 NEW IND120,JND120,PXRMDONE
+30 SET IND120=$PIECE(TEMP,U,2)
SET JND120=$PIECE(TEMP,U,3)
SET PXRMDONE=0
+31 DO INSDLG(PXRMRIEN,IND120,JND120,ACTION)
End DoDot:2
QUIT
+32 ;Install component
+33 IF '$TEST
DO INSCOM(PXRMRIEN,ACTION,IND,TEMP,"PXRMEXIA")
End DoDot:1
+34 ;
+35 ;Get the dialog name
+36 SET DNAME=""
FOR
SET DNAME=$ORDER(^TMP("PXRMEXDL",$JOB,DNAME))
IF DNAME=""
QUIT
Begin DoDot:1
+37 SET RNAME=""
+38 FOR
SET RNAME=$ORDER(^TMP("PXRMEXDL",$JOB,DNAME,RNAME))
IF RNAME=""
QUIT
Begin DoDot:2
+39 ;Link the dialog if it exists
+40 NEW DIEN,RIEN
+41 ;Get the dialog ien.
+42 SET DIEN=$$EXISTS^PXRMEXIU(801.41,DNAME)
IF 'DIEN
QUIT
+43 ;Get the reminder ien.
+44 SET RIEN=+$$EXISTS^PXRMEXIU(811.9,$GET(RNAME))
IF 'RIEN
QUIT
+45 NEW DA,DIE,DIK,DR
+46 ;Set reminder to dialog pointer.
+47 SET DR="51///^S X=DNAME"
SET DIE="^PXD(811.9,"
SET DA=RIEN
+48 DO ^DIE
End DoDot:2
End DoDot:1
+49 ;
+50 ;Save the install history.
+51 DO SAVHIST^PXRMEXU1
+52 ;If any components were skipped send the message.
+53 IF $DATA(^TMP("PXRMEXNI",$JOB))
Begin DoDot:1
+54 NEW NE,XMSUB
+55 SET NE=$ORDER(^TMP("PXRMEXNI",$JOB,""),-1)+1
+56 SET ^TMP("PXRMEXNI",$JOB,NE,0)="Please review and make changes as necessary."
+57 KILL ^TMP("PXRMXMZ",$JOB)
+58 MERGE ^TMP("PXRMXMZ",$JOB)=^TMP("PXRMEXNI",$JOB)
+59 SET XMSUB="COMPONENTS SKIPPED DURING SILENT MODE INSTALL"
+60 DO SEND^PXRMMSG("PXRMXMZ",XMSUB,"",DUZ)
End DoDot:1
+61 ;Cleanup TMP globals.
+62 DO INITMPG^PXRMEXLM
+63 QUIT
+64 ;
+65 ;=======================================
LDARRAY(MODE,ENTRY,ROUTINE,ARRAY) ;Load ARRAY with
+1 ;MODE is a string that may contain any of the following:
+2 ; A = include action, stored in the third column of the ARRAY entry.
+3 ; I = include in build, used for the data screen in the KIDS build.
+4 ; If MODE contains I then the date and time are stored in the second
+5 ; column of the ARRAY entry.
+6 ; L = load action, store the name in the first column of the ARRAY
+7 ; entry. This is the default and both A and I imply L.
+8 ;ENTRY is the entry point in ROUTINE which is called to populate
+9 ;ARRAY.
+10 NEW RTN
+11 SET RTN=ENTRY_"^"_ROUTINE_"(MODE,.ARRAY)"
+12 DO @RTN
+13 QUIT
+14 ;
+15 ;=======================================
SMEXINS(ENTRY,ROUTINE) ;Silent mode install.
+1 NEW ACTION,EXARRAY,FMTSTR,IC,IEN,LUVALUE,NOUT,NTI,PXRMINST,TEXT,TEXTOUT
+2 SET PXRMINST=1
+3 DO LDARRAY^PXRMEXSI("IA",ENTRY,ROUTINE,.EXARRAY)
+4 SET NTI=$ORDER(EXARRAY(""),-1)
SET NTI=$LENGTH(NTI)+1
+5 SET FMTSTR=NTI_"R1^"_(77-NTI)_"L"
+6 SET IC=0
+7 FOR
SET IC=$ORDER(EXARRAY(IC))
IF 'IC
QUIT
Begin DoDot:1
+8 SET LUVALUE(1)=EXARRAY(IC,1)
SET LUVALUE(2)=EXARRAY(IC,2)
+9 SET IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
+10 IF IEN=0
QUIT
+11 SET TEXT=IC_".^Installing Reminder Exchange entry "_LUVALUE(1)
+12 KILL TEXTOUT
+13 DO COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NOUT,.TEXTOUT)
+14 DO MES^XPDUTL(.TEXTOUT)
+15 SET ACTION=EXARRAY(IC,3)
+16 DO INSTALL^PXRMEXSI(IEN,ACTION,1,1)
End DoDot:1
+17 QUIT
+18 ;
