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

XPDET.m

Go to the documentation of this file.
  1. XPDET ;SFISC/RSD - Input transforms & help for file 9.6 & 9.7 ;10/19/2002
  1. ;;8.0;KERNEL;**15,39,41,44,51,58,66,137,229,393,539,672,713**;Jul 10, 1995;Build 15
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. INPUTB(X) ;input transform for NAME in BUILD file
  1. ;X=user input
  1. ;name must be unique
  1. I $L(X)>50!($L(X)<3)!$D(^XPD(9.6,"B",X)) K X Q
  1. I X["*" K:$P(X,"*",2,3)'?1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.6N.1"b" X Q ;p713
  1. S %=$L(X," ") I %<2 K X Q
  1. S %=$P(X," ",%) K:%'?1.2N1"."1.2N.1(1"V",1"T",1"B").2N.1"b" X ;p172 add "b"
  1. Q
  1. INPUTE(X) ;input transform for ENTRIES in KERNEL FILES multiple
  1. ;X=user input
  1. N D,DD,DIC,DICR,DIX,DIY,DS,DO,XPDLK,Y
  1. S XPDLK=$$GR(D1)
  1. I XPDLK=""!X["*" K X Q
  1. S DIC(0)="QEMZ",DIC=XPDLK
  1. S:D1=9.8 DIC("S")="I $T(^@$P(^(0),U))]"""""
  1. D ^DIC K:Y<0 X Q:'$D(X)
  1. S X=Y(0,0)
  1. ;check that this doesn't exist already
  1. I $D(^XPD(9.6,D0,"KRN",D1,"NM","B",X)) K X Q
  1. ;if fm file, change X to contain file # of template
  1. I D1<.404 S X=$$TX(X,$P(Y(0),U,$S(D1=.403:8,1:4)))
  1. ;POLICY FUNCTION file #1.62, entries below 1000 belong to FileMan
  1. I D1=1.62 K:Y<1000 X
  1. Q
  1. GLOBALE(X) ;input transform for GLOBAL multiple .01 field in file 9.6
  1. I $L(X)>30!($L(X)<2) K X Q
  1. I X["(",X'[")" K X Q
  1. ;change ' back to " for subscripts, they were changed in the Pre-Lookup node of the DD, 7.5. This was done to trick FM, which doesn't allow " in .01 fields
  1. S X=$TR(X,"'","""")
  1. I '$D(@("^"_X)) K X
  1. Q
  1. INPUTMB(X) ;input transform for field 10 and 11 in file 9.6
  1. ;X=user input
  1. N D,DD,DIC,DICR,DIX,DIY,DS,DO,Y
  1. ;can't select a global or multi package or itself (D0)
  1. S DIC(0)="QEMZ",DIC="^XPD(9.6,",DIC("S")="I '$P(^(0),U,3),Y'="_D0
  1. D ^DIC K:Y<0 X Q:'$D(X)
  1. S X=Y(0,0)
  1. Q
  1. LOOKE(X) ;special lookup for ENTRIES in KERNEL FILES multiple
  1. Q:X'?1.E1"*"
  1. N %,XPD,XPDI,XPDIC,XPDF,XPDLK,XPDX,Y
  1. S XPDLK=$$GR(D1),XPDIC=DIC,XPDF=D1
  1. I XPDLK="" K X Q
  1. G:$E(X)="-" DEL
  1. S XPDX=$P(X,"*"),XPDI("IEN")=0
  1. D LIST^DIC(D1,"","@;.01","","*",.XPDI,XPDX,"","I $$SCR^XPDET(Y)")
  1. I '$G(^TMP("DILIST",$J,0)) K X Q
  1. K ^TMP("XPDX",$J)
  1. ;loop thru list from lister and file using UPDATE^DIE
  1. F XPDI=1:1 S X=$G(^TMP("DILIST",$J,"ID",XPDI,.01)) Q:X="" D
  1. .;FM template will have file # associated with the template name
  1. .S:D1<.404 %=^TMP("DILIST",$J,2,XPDI)_",",X=$$TX(X,$$GET1^DIQ(D1,%,$$TF(D1),"I"))
  1. .;Lock Template, #8993, need to remove leading "^" if there
  1. .S:D1=8993&($E(X)="^") X=$P(X,"^",2)
  1. .S Y="+"_XPDI_","_D1_","_D0_",",^TMP("XPDX",$J,9.68,Y,.01)=X,^(.03)=0
  1. I $D(^TMP("XPDX",$J)) D UPDATE^DIE("","^TMP(""XPDX"",$J)","^TMP(""XPD"",$J)")
  1. ;if in Screenman then call MLOAD to update screen
  1. I $D(DDS),$D(^TMP("XPD",$J)) D MLOAD^DDSUTL("^TMP(""XPD"",$J)")
  1. S X=""
  1. K ^TMP("XPDX",$J),^TMP("XPD",$J)
  1. Q
  1. DEL ;delete using wild card
  1. I X'?1"-"1.E1"*" K X Q
  1. S X=$E(X,2,$L(X)-1),XPDX=X S:$L(X) XPDI("IEN")=0
  1. D LIST^DIC(9.68,","_D1_","_D0_",","","","*",.XPDI,XPDX)
  1. I '$G(^TMP("DILIST",$J,0)) K X Q
  1. N DIK,DA,D2
  1. S DIK=XPDIC,DA(1)=D1,DA(2)=D0
  1. F XPDI=1:1 S (DA,D2)=$G(^TMP("DILIST",$J,2,XPDI)) Q:'DA D
  1. .D ^DIK
  1. I $D(DDS) D MDEL^DDSUTL("^TMP(""DILIST"",$J,2)")
  1. S X=""
  1. K ^TMP("DILIST",$J)
  1. Q
  1. HELP ;executable help of ENTRIES in KERNEL FILE multiple
  1. N D,DIC,DIE,DIX,DIY,DO,DZ,DS,X,Y
  1. ;file 9.8 is routine file, check that routine exists
  1. S DIC=$$GR(D1),DIC(0)="M",X="??" Q:DIC="" S:D1=9.8 DIC("S")="I $T(^@$P(^(0),U))]"""""
  1. D ^DIC Q
  1. ;
  1. HELPO ;executable help of INSTALL ORDER in KERNEL FILES multiple
  1. N Y
  1. W !,"Numbers in use: ORDER FILE#" S Y=0
  1. F S Y=$O(^XPD(9.6,D0,"KRN","AC",Y)) Q:'Y W !,?18,$J(Y,2),?28,$O(^(Y,0))
  1. W ! Q
  1. ;
  1. HELPMB ;executable help of fields 10 & 11 in file 9.6
  1. N D,DIC,DIE,DIX,DIY,DO,DZ,DS,X,Y
  1. S DIC="^XPD(9.6,",DIC(0)="M",X="??",DIC("S")="I '$P(^(0),U,3),Y'="_D0
  1. D ^DIC Q
  1. ;
  1. SCRA(Y) ;screen of ACTION field in ENTRIES multiple in KERNEL FILES multiple, Y=action
  1. ;Y=0 - send, 1 - delete, 2 - link, 3 - merge, 4 - attach, 5 - disable
  1. ;all entries can send to site
  1. ;D0=Build ien, D1=File #, D2=record #
  1. Q:'Y 1
  1. ;.5=function file, can't delete, all others can
  1. I Y=1 Q (D1'=.5)
  1. ;then rest of code check if it is a Option, Protocal, and Policy and can have MENU ITEMS
  1. Q:D1'=19&(D1'=101)&(D1'=1.6) 0
  1. ;only Options and Protocol can disable, Policy can't
  1. I Y=5 Q (D1'=1.6)
  1. N FGR,X,XPDF,XPDT,XPDY,XPDZ
  1. ;get X=name, FGR=global reference, XPDF=file #
  1. S XPDY=Y,XPDF=D1,X=$P(^XPD(9.6,D0,"KRN",D1,"NM",D2,0),U),FGR=$$FILE^XPDV(D1)
  1. Q:X="" 0
  1. ;X=ien of protocol, option, or policy
  1. S X=+$O(@FGR@("B",X,0)) Q:'X 0
  1. ;get type
  1. S XPDT=$S(XPDF=1.6:$P($G(@FGR@(X,0)),U,2),1:$P($G(@FGR@(X,0)),U,4))
  1. ;Policy; Type=Rule only send & delete
  1. I XPDF=1.6,XPDT="R" Q (XPDY<2)
  1. ;Policy; Type=Set or Policy, if Members then okay, else allow only send & delete
  1. I XPDF=1.6,XPDT'="R" Q:$O(@FGR@(X,10,0)) 1 Q (XPDY<2)
  1. ;all Options and Protocols, except Event Drivers, can be attached
  1. I XPDY=4 Q '(XPDF=101&(XPDT="E"))
  1. ;Protocol and Type is Subscriber can't do anything else
  1. I XPDF=101,XPDT="S" Q 0
  1. ;if it has SUBSCRIBERS, node 775 then ok
  1. I $O(@FGR@(X,775,0)) Q 1
  1. ;if type is menu,potocol,protocol menu,limited,extended,window suite
  1. I "MOQLXZ"[XPDT Q 1
  1. ;if it has ITEMs, node 10 then ok
  1. I $O(@FGR@(X,10,0)) Q 1
  1. Q 0
  1. ;
  1. ;only Fileman templates need to know what file they are associated with.
  1. ;this value is also triggered to field .02 in the DD.
  1. TX(X,Y) ;X=template name, Y=file #
  1. Q X_" FILE #"_Y
  1. ;
  1. TF(F) ;F=file, return field of file# for templates
  1. Q $S(F>.403:"",F<.403:4,1:7)
  1. ;
  1. GR(X) Q $G(^DIC(X,0,"GL"))
  1. ;
  1. ;screens checks that X is not already in the ENTRIES multiple
  1. SCR(Y) ;screen logic for ENTRIES multiple in file 9.6
  1. N %,X,Z
  1. S Z=^(0),X=$P(Z,U)
  1. ;FM files are less than .44
  1. I XPDF<.44 D Q:X="" 0
  1. .S %=$S(XPDF=.403:$P(Z,U,8),1:$P(Z,U,4)),X=X_" FILE #"_%
  1. .S:XPDF'=.403&($P(Z,U,8)>2) %=0 S:'% X=""
  1. ;routine must exist and must be type 'R'
  1. I XPDF=9.8 Q:$T(^@X)=""!($P(Z,U,2)'="R") 0
  1. Q '$D(@(XPDIC_"""B"",X)"))
  1. ;
  1. ;screen checks that X is not in the exclude list, XPDN(0)
  1. SCR1(Y) ;screen logic for exclude list
  1. N %,X
  1. ;if name X is in the exclude list, XPDN(0,X), then fail
  1. S Y(0)=^(0),X=$P(Y(0),U) Q:$D(XPDN(0,X)) 0
  1. ;check if X is refered in the namespace by check the subscript
  1. ;before X, if sub exist and $P(X,sub)="" then it is part of the
  1. ;namespace, fail and return 0
  1. S %=$O(XPDN(0,X),-1) I $L(%) Q:$P(X,%)="" 0
  1. Q $$SCR(.Y)
  1. ;
  1. ;screen on PACKAGE LINK field in file 9.6,
  1. PCK(Y) ;check Package File name, Y=ien in package file
  1. N %,Y,Z
  1. S Z=^(0)
  1. ;DA is undef when you are adding a new Build without a version number
  1. Q:'$D(^XPD(9.6,+$G(DA),0)) 1
  1. S Y=$L($P(Z,U)),%=$P(^XPD(9.6,DA,0),U),%=$$PKG^XPDUTL(%)
  1. Q $P(Z,U)=$E(%,1,Y)!($P(Z,U,2)=%)
  1. VOLE(X) ;input transform for VOLUME SET multiple in INSTALL file
  1. ;X=user input
  1. N D,DD,DIC,DICR,DIX,DIY,DO,DS,XPD,Y,%
  1. ;(0;11)=SIGNON/PRODUCTION
  1. S DIC(0)="QEMZ",DIC="^%ZIS(14.5,",DIC("S")="I $P(^(0),U,11)"
  1. D ^DIC K:Y<0 X Q:'$D(X)
  1. S X=Y(0,0)
  1. Q
  1. VOLH ;executable help for VOLUME SET multiple in INSTALL file
  1. N D,DD,DIC,DIE,DIX,DIY,DO,DS,DZ,X,Y,%
  1. S X="??",DIC(0)="QEMZ",DIC="^%ZIS(14.5,",DIC("S")="I $P(^(0),U,11)"
  1. D ^DIC
  1. Q
  1. ID97 ;identifier for Install file
  1. N XPDET,XPD,XPD0,XPD1,XPD2,XPD9
  1. S XPD0=$G(^(0)),XPD1=$G(^(1)),XPD2=$G(^(2)),XPD9=$P(XPD0,U,9),XPD="" Q:XPD9=""
  1. D
  1. .;Loaded, get DATE LOADED
  1. .I 'XPD9 S XPD=$$FMTE^XLFDT($P(XPD0,U,3),2) Q
  1. .Q:XPD9>4
  1. .;Started, get INSTALL START TIME
  1. .I XPD9=2 S XPD=$$FMTE^XLFDT($P(XPD1,U),2) Q
  1. .;Completed or De-Installed, get INSTALL COMPLETE TIME
  1. .I XPD9>2 S XPD=$$FMTE^XLFDT($P(XPD1,U,3),2) Q
  1. .;Queued, get QUEUED TASK NUMBER
  1. .I XPD9=1 S XPD="#"_$P(XPD0,U,6) Q
  1. ;S XPDET(1)=" "_$$EXTERNAL^DILFD(9.7,.02,"",XPD9)_" "_XPD,XPDET(1,"F")="?0"
  1. S XPDET(1)=" "_XPD,XPDET(1,"F")="?0"
  1. S:XPD2]"" XPDET(2)="=> "_$E(XPD2,1,70),XPDET(2,"F")="!?5"
  1. D EN^DDIOL(.XPDET)
  1. Q
  1. ;not being used right now,
  1. DEL97(Y) ;delete access to file 9.7, 0-can't delete, 1-can
  1. N %
  1. S %=$P(^XPD(9.7,Y,0),U,9)
  1. Q $S(%=3:1,%=2:0,$D(^XPD(9.7,"ASP",Y,1,Y)):1,1:0)
  1. ;
  1. PAR964 ;Clear other fields if file is partial. Called from within form
  1. D PUT^DDSVAL(DIE,.DA,222.7,"n","","I") ;Send data NO
  1. D PUT^DDSVAL(DIE,.DA,222.5,"","","I") ;Resolve pointer
  1. D PUT^DDSVAL(DIE,.DA,222.8,"","","I") ;Sites Data
  1. D PUT^DDSVAL(DIE,.DA,222.9,"n","","I") ;User Override
  1. D PUT^DDSVAL(DIE,.DA,224,"","","I") ;Data Screen
  1. Q
  1. ;