Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XPDIK

XPDIK.m

Go to the documentation of this file. 
  1. XPDIK ;SFISC/RSD - Install Kernel Files & FM Files ;04/26/2004  11:20
  1.  ;;8.0;KERNEL;**15,58,108,124,146,346**;Jul 10, 1995
  1.  Q
  1. KRN ;
  1.  ;XPDA=package ien in INSTALL FILE, XPDNM=package name, XPDCP= check points
  1.  N DA,DIC,DIOVRD,EPOS,EPRE,FDEL,FPOS,FPRE,OLDA,ORD,X,XGCEDITR,XPDFIL,XPDFILNM,XPDFL,XPDNEW,XREF,Y,%
  1.  ;DIOVRD is used to override write protection on a file
  1.  ;XGCEDITR is check in file 8995, at 'SCR' node of DD
  1.  S ORD=0,XPDCP="KRN",(DIOVRD,XGCEDITR)=1
  1.  F  S ORD=$O(^XTMP("XPDI",XPDA,"ORD",ORD)) Q:'ORD  S XPDFIL=+$O(^(ORD,0)),XREF=$G(^(XPDFIL)),XPDFILNM=$G(^(XPDFIL,0)) D:XPDFIL
  1.  .;sets up EPOS,EPRE,FDEL,FPOS,FPRE variables
  1.  .F DA=1:1:5 S @$P("FPRE^EPRE^FPOS^EPOS^FDEL",U,DA)=$P(XREF,";",DA+5)
  1.  .K DIC,^TMP($J,"XPDEL")
  1.  .S DIC=$G(^DIC(XPDFIL,0,"GL")),XREF=+$P(XREF,";",3)
  1.  .;check if file, XPDFIL, exist at this site
  1.  .I $P($G(^DIC(XPDFIL,0)),U)'=XPDFILNM D BMES^XPDUTL(" File "_XPDFIL_" is not "_XPDFILNM_", nothing installed.") Q
  1.  .;check if XPDFIL has already been installed
  1.  .I $P(^XPD(9.7,XPDA,"KRN",XPDFIL,0),U,2) D BMES^XPDUTL(" "_XPDFILNM_" already installed.") Q
  1.  .D BMES^XPDUTL(" Installing "_XPDFILNM),SETTOT^XPDID(XPDFIL)
  1.  .;do File Pre-install action, continue if ok
  1.  .;XPDFL= 0-send,1-delete,2-link,3-merge,4-attach,5-disable
  1.  .;loops thru the entries for this file
  1.  .I '$$ACT(FPRE) S OLDA=0 F  S OLDA=$O(^XTMP("XPDI",XPDA,"KRN",XPDFIL,OLDA)) Q:'OLDA  S XPDFL=+$G(^(OLDA,-1)),OLDA(0)=^(0) D
  1.  ..;if we are doing VT graphic display, set counter
  1.  ..I $D(XPDIDVT) S XPDIDCNT=XPDIDCNT+1 D:'(XPDIDCNT#XPDIDMOD) UPDATE^XPDID(XPDIDCNT)
  1.  ..;quit if disable or attach (4 or 5).  Attach will be processed under the parent menu.
  1.  ..Q:XPDFL>3
  1.  ..;if FM file, need to set screening logic
  1.  ..I XPDFIL<.44 S %=$S(XPDFIL'=.403:4,1:8),DIC("S")="I $P(^(0),U,"_%_")="_$P(OLDA(0),U,%)
  1.  ..;if deleting at site and a template, reset the lookup value and DIC("S")
  1.  ..I XPDFL=1,XPDFIL<.44 S %=$P(OLDA(0),U),$P(OLDA(0),U)=$P(%,"    FILE #"),DIC("S")="I $P(^(0),U,"_$S(XPDFIL'=.403:4,1:8)_")="_+$P(%,"    FILE #",2)
  1.  ..;XPDNEW=1 if entry is new, laygo
  1.  ..S X=$P(OLDA(0),U),Y=$$DIC(XPDFIL,X,$G(DIC("S")),XPDFL) Q:'Y  S DA=+Y,XPDNEW=$P(Y,U,3)
  1.  ..;if deleting then save and process after FPOS
  1.  ..I XPDFL=1 S ^TMP($J,"XPDEL",DA)="" Q
  1.  ..;do Entries Pre-install action
  1.  ..Q:$$ACT(EPRE)
  1.  ..;merges the data, if you want the data deleted before the merge, you must
  1.  ..;do it in the Entry Pre-install node, EPRE.
  1.  ..M @(DIC_DA_")")=^XTMP("XPDI",XPDA,"KRN",XPDFIL,OLDA)
  1.  ..;kill the flag node from the live data node
  1.  ..K @(DIC_DA_",-1)") Q:$$ACT(EPOS)
  1.  ..;XREF is flag to x-ref file after each entry, it is set in file 9.6
  1.  ..I XREF N DIK S DIK=DIC D IX1^DIK
  1.  .;do File Post Install Action
  1.  .S %=$$ACT(FPOS)
  1.  .;process the deleting of entries, FDEL should allow the passing of all entries
  1.  .;to delete in array ^TMP($J,"XPDEL",DA)=""
  1.  .I $L(FDEL),$D(^TMP($J,"XPDEL")) S %="^TMP($J,""XPDEL"")" D @FDEL
  1.  .;complete check point
  1.  .S %=$$XPCOM(XPDFIL)
  1.  .K ^TMP($J,"XPDEL")
  1.  .I $D(XPDIDVT) D UPDATE^XPDID(XPDIDCNT)
  1.  Q
  1. FIA ;
  1.  ;XPFIL2=file is new^DD screen failed^data already exists^change file name^don't add data; 1=yes, 0=no
  1.  N XPGR,XPFIL,XPFILO,XPFIL2,Z
  1.  S XPFIL=0,XPGR=$NA(^XTMP("XPDI",XPDA))
  1.  F  S XPFIL=$O(^XTMP("XPDI",XPDA,"FIA",XPFIL)) Q:'XPFIL  S XPFILO=^(XPFIL,0,1),XPFIL2=^(2) D
  1.  .;if we are doing VT graphic display, set counter
  1.  .I $D(XPDIDVT) S XPDIDCNT=XPDIDCNT+1 D:'(XPDIDCNT#XPDIDMOD) UPDATE^XPDID(XPDIDCNT)
  1.  .;file is new, alway install DD
  1.  .S:XPFIL2 $P(XPFILO,U)="y",$P(^XTMP("XPDI",XPDA,"FIA",XPFIL,0,1),U)="y"
  1.  .;DD failed screen
  1.  .I $P(XPFIL2,U,2) D  Q
  1.  ..N XPD
  1.  ..S XPD(1)=" ",XPD(2)="Data Dictionary for File #"_XPFIL_" not installed, failed DD screen."
  1.  ..D MES^XPDUTL(.XPD) S %=$$XPCOM(XPFIL)
  1.  .;if udate DD question = no & file is not new update checkpoint
  1.  .I $P(XPFILO,U)'="y"&'XPFIL2 S %=$$XPCOM(XPFIL)
  1.  .;check if XPFIL has already been installed
  1.  .Q:$P(^XPD(9.7,XPDA,4,XPFIL,0),U,2)
  1.  .;update file name
  1.  .I $P(XPFIL2,U,4) D
  1.  ..N DIE,DR,DA
  1.  ..S DR=".01////"_^XTMP("XPDI",XPDA,"FIA",XPFIL),DA=XPFIL,DIE=1
  1.  ..D ^DIE
  1.  .;move DD and check for errors
  1.  .D DDIN^DIFROMS(XPFIL,"","",XPGR),DIERR("** ERROR IN DATA DICTIONARY FOR FILE # "_XPFIL_" **"):$D(DIERR)
  1.  .S %=$$XPCOM(XPFIL)
  1.  I $D(XPDIDVT) D UPDATE^XPDID(XPDIDTOT)
  1.  Q
  1. DAT ;
  1.  N XPGR,XPFIL,XPFILO,XPFIL2,Z
  1.  S XPFIL=0,XPGR=$NA(^XTMP("XPDI",XPDA))
  1.  ;DO if they are sending data
  1.  F  S XPFIL=$O(^XTMP("XPDI",XPDA,"FIA",XPFIL)) Q:'XPFIL  S XPFILO=^(XPFIL,0,1),XPFIL2=^(2) D:$P(XPFILO,U,7)="y"
  1.  .;DD failed screen or answer no to adding data or 'Add if new' & data already exists or file doesn't exist
  1.  .I $P(XPFIL2,U,2)!$P(XPFIL2,U,5)!($P(XPFILO,U,8)="a"&$P(XPFIL2,U,3))!'$D(^DIC(XPFIL,0)) S %=$$XPCOM(XPFIL,1) Q
  1.  .;check if XPFIL has already been installed or no data to input
  1.  .Q:$P(^XPD(9.7,XPDA,4,XPFIL,0),U,3)!('$D(^XTMP("XPDI",XPDA,"DATA",XPFIL)))
  1.  .;bring in Data and check for error
  1.  .D DATAIN^DIFROMS(XPFIL,"","",XPGR),DIERR("** ERROR IN DATA FOR FILE # "_XPFIL_" **"):$D(DIERR)
  1.  .S %=$$XPCOM(XPFIL,1)
  1.  D RP^DIFROMSR("","",XPGR),DIERR("** ERROR IN POINTER RESOLUTION OF DATA **"):$D(DIERR)
  1.  Q
  1.  ;record error
  1. DIERR(XPDI) N XPD
  1.  D MSG^DIALOG("AE",.XPD) Q:'$D(XPD)
  1.  D BMES^XPDUTL(XPDI),MES^XPDUTL(.XPD)
  1.  Q
  1.  ;
  1.  ;XPDF=file #,X=input,XPDS=screen logic, XPDACT=action
  1. DIC(XPDF,XPDX,XPDS,XPDACT) ;
  1.  N DIC,DIERR,XPD,XPDN
  1.  S DIC=$G(^DIC(XPDF,0,"GL"))
  1.  D FIND^DIC(XPDF,"","","XQf",XPDX,5,"",$G(XPDS),"","XPD")
  1.  ;one or more matches, just return first one
  1.  I $G(XPD(0)) D:XPD(0)>1  Q XPD(1)
  1.  .N %
  1.  .S %(1)=$P($G(^DIC(XPDF,0)),U)_"  "_XPDX_"  is Duplicated,",%(2)=" only ien #"_XPD(1)_" was updated."
  1.  .D MES^XPDUTL(.%)
  1.  ;no match and action=(delete,link, or attach), don't write message if deleting
  1.  I $G(XPDACT),XPDACT'=3 D:XPDACT'=1 BMES^XPDUTL(" "_$P($G(^DIC(XPDF,0)),U)_" "_XPDX_" Lookup failed, NO Action Taken.") Q 0
  1.  ;add a new entry
  1.  N DLAYGO,X,Y
  1.  S X=XPDX,DIC(0)="LX",DLAYGO=XPDF,DIC("S")=$G(XPDS) D ^DIC
  1.  I Y<0 D BMES^XPDUTL(" "_$P($G(^DIC(XPDF,0)),U)_" "_XPDX_" **Couldn't Add to file**") Q 0
  1.  Q Y
  1.  ;code can't be used until UPDATE^DIE allows the creation of a record
  1.  ;without required identifiers
  1.  ;K XPD,DIERR
  1.  ;S XPD(XPDF,"+1,",.01)=XPDX
  1.  ;D UPDATE^DIE("","XPD","XPDN")
  1.  ;couldn't add as new
  1.  ;I $D(DIERR) D DIERR(" "_$P($G(^DIC(XPDF,0)),U)_" "_XPDX_" **Couldn't Add to file**") Q 0
  1.  ;I '$G(XPDN(1)) D BMES^XPDUTL(" "_$P($G(^DIC(XPDF,0)),U)_" "_XPDX_" **Couldn't Add to file**") Q 0
  1.  ;Q XPDN(1)
  1.  ;
  1. ACT(%) ;execute action, returns 0 to continue, 1 to quit
  1.  ;user can count on DIC,DA,XPDFIL,OLDA,XPDNM,XPDFL,X,Y being around
  1.  ;XPDNEW is set only for Entry Pre-install action
  1.  Q:%="" 0
  1.  N %1,%2,%3 S %1=$G(DIC),%2=$G(DA),%3=$G(OLDA)
  1.  N DA,DIC,DIOVRD,OLDA,EPOS,EPRE,FPOS,FPRE,ORD,XREF,XPDQUIT
  1.  S DIC=%1,DA=%2,OLDA=%3
  1.  S:%'["^" %="^"_%
  1.  ;XPDQUIT=quit this level of processing
  1.  D @% Q $D(XPDQUIT)
  1.  Q
  1.  ;
  1. XPCOM(XPDF,XPDJ) ;complete checkpoint for file XPDF
  1.  ;XPDJ=1 only for data of fm files, it set the field to edit = 2
  1.  N XPD,%,Z
  1.  S %=$$NOW^XLFDT,Z=$S(XPDCP="KRN":9.715,1:9.714),XPD(Z,XPDF_","_XPDA_",",$G(XPDJ)+1)=%
  1.  ;if Build Components, save the ORDer number
  1.  S:Z=9.715 XPD(Z,XPDF_","_XPDA_",",2)=ORD
  1.  D FILE^DIE("","XPD")
  1.  Q 1
  1.  ;
  1. XPCK(XPDI) ;setup check points for file type XPDI
  1.  ;XPDI="KRN"-components, ="FIA"-files
  1.  N %,XPD,XPDF,XPDJ,XPDK
  1.  ;XPDK=sub DD
  1.  S XPDK=$S(XPDI="KRN":9.715,1:9.714),XPDF=0
  1.  F %=1:1 S XPDF=$O(^XTMP("XPDI",XPDA,XPDI,XPDF)) Q:'XPDF  S (XPDJ(%),XPD(XPDK,"+"_%_","_XPDA_",",.01))=XPDF
  1.  D:$D(XPD)>9 UPDATE^DIE("","XPD","XPDJ")
  1.  Q