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

XPDT.m

Go to the documentation of this file. 
  1. XPDT ;SFISC/RSD - Transport a package ;02/12/2009
  1.  ;;8.0;KERNEL;**2,10,28,41,44,51,58,66,68,85,100,108,393,511,539,547,1018**;Jul 10, 1995;Build 8
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1. EN ;build XTMP("XPDT",ien, XPDA=ien,XPDNM=name
  1.  ;XPDT(seq #)=ien^name^1=use current transport global on system
  1.  ;XPDT("DA",ien)=seq #
  1.  ;XPDVER=version number^package name
  1.  ;XPDGP=flag;global^flag;global^...  flag=1 replace global at site
  1.  N DIR,DIRUT,I,POP,XPD,XPDA,XPDERR,XPDGP,XPDGREF,XPDH,XPDH1,XPDHD,XPDI,XPDNM,XPDSEQ,XPDSIZ,XPDSIZA,XPDT,XPDTP,XPDVER
  1.  N DUOUT,DTOUT,XPDFMSG,X,Y,Z,Z1
  1.  K ^TMP($J,"XPD")
  1.  S XPD="First Package Name: ",DIR(0)="Y",DIR("A")="   Use this Transport Global",DIR("?")="Yes, will use the current Transport Global on your system. No, will create a new one.",XPDT=0
  1.  W !!,"Enter the Package Names to be transported. The order in which",!,"they are entered will be the order in which they are installed.",!!
  1.  F  S XPDA=$$DIC^XPDE("AEMQZ",XPD) Q:'XPDA  D  Q:$D(DIRUT)!$D(XPDERR)
  1.  .S:'XPDT XPD="Another Package Name: "
  1.  .;XPDI=name^1=use current transport global
  1.  .S XPDI=$P(Y(0),U)_"^"
  1.  .I $D(XPDT("DA",XPDA)) W "   ",$P(Y(0),U)," already listed",! Q
  1.  .;if type is Global Package, set DIRUT if there is other packages
  1.  .I $P(Y(0),U,3)=2 W "   GLOBAL PACKAGE" D  Q
  1.  ..;if there is already a package in distribution, abort
  1.  ..I XPDT S DIRUT=1 W !,"A GLOBAL PACKAGE cannot be sent with any other packages" Q
  1.  ..I $D(^XTMP("XPDT",XPDA)) W "  **Cannot have a pre-existing Transport Global**" S DIRUT=1 Q
  1.  ..W !?10,"will transport the following globals:",! S X=0,XPDGP=""
  1.  ..F  S X=$O(^XPD(9.6,XPDA,"GLO",X)) Q:'X  S Z=$G(^(X,0)) I $P(Z,U)]"" S XPDGP=XPDGP_($P(Z,U,2)="y")_";"_$P(Z,U)_"^" W ?12,$P(Z,U),!
  1.  ..;XPDERR is set to quit loop, so no other packages can be added
  1.  ..S XPDERR=1,XPDT=XPDT+1,XPDT(XPDT)=XPDA_U_XPDI,XPDT("DA",XPDA)=XPDT
  1.  .Q:$D(XPDERR)
  1.  .D PCK(XPDA,XPDI)
  1.  .;multi-package
  1.  .Q:$P(Y(0),U,3)'=1
  1.  .W "   (Multi-Package)" S X=0
  1.  .I XPDT>1 S DIRUT=1 W !,"A Master Build must be the first/only package in a transport" Q
  1.  .F  S X=$O(^XPD(9.6,XPDA,10,X)) Q:'X  S Z=$P($G(^(X,0)),U),Z1=$P($G(^(0)),U,2) D:Z]""
  1.  ..N XPDA,X
  1.  ..S Z=$P(^XPD(9.6,Z,0),U,1)  ;XU*8.0*1018 - IHS/OIT/FBD - 5/16/2011 - ADDED LINE TO CORRECT MULTIPACKAGE MALFUNCTIONS
  1.  ..W !?3,Z S XPDA=$O(^XPD(9.6,"B",Z,0))
  1.  ..I 'XPDA W "  **Can't find definition in Build file**" Q
  1.  ..I $D(XPDT("DA",XPDA)) W "  already listed" Q
  1.  ..D PCK(XPDA,Z,Z1)
  1.  .S XPDERR=1 ;XPDERR is set to quit loop, so no other packages can be added
  1.  .Q
  1.  G:'XPDT!$D(DIRUT) QUIT K XPDERR
  1.  W !!,"ORDER   PACKAGE",!
  1.  F XPDT=1:1:XPDT S Y=$P(XPDT(XPDT),U,2) W ?2,XPDT,?7,Y D  W !
  1.  .W:$P(XPDT(XPDT),U,3) "     **will use current Transport Global**"
  1.  .;check if New Version and single package, has Package File Link, Package App. History
  1.  .Q:Y["*"!'$$PAH(+XPDT(XPDT))
  1.  .S DIR(0)="Y",DIR("A")="Send the PATCH APPLICATION HISTORY from the PACKAGE file",DIR("B")="YES"
  1.  .W !! D ^DIR I 'Y S $P(XPDT(XPDT),U,5)=1
  1.  S DIR(0)="Y",DIR("A")="OK to continue",DIR("B")="YES",XPDH=""
  1.  W !! D ^DIR G:$D(DIRUT)!'Y QUIT K DIR
  1.  I $G(XPDTP),XPDT>1 W !!,"You cannot send multiple Builds through PackMan."
  1.  S DIR(0)="SAO^HF:Host File"_$S(XPDT=1:";PM:PackMan",1:"")
  1.  S DIR("A")="Transport through (HF)Host File"_$S(XPDT=1:" or (PM)PackMan: ",1:": ")
  1.  S DIR("?")="Enter the method of transport for the package(s)."
  1.  D ^DIR G:$D(DTOUT)!$D(DUOUT) QUIT K DIR
  1.  I Y="" W !,"No Transport Method selected, will only write Transport Global to ^XTMP." S XPDH=""
  1.  ;XPDTP = transports using Packman
  1.  S:Y="PM" XPDTP=1
  1.  I $D(XPDGP),Y'="HF" W !,"**Global Package can only be sent with a Host File, Transport ABORTED**" Q
  1.  I Y="HF" D DEV G:POP QUIT
  1.  W !!
  1.  F XPDT=1:1:XPDT S XPDA=XPDT(XPDT),XPDNM=$P(XPDA,U,2) D  G:$D(XPDERR) ABORT
  1.  .W !?5,XPDNM,"..." S XPDGREF="^XTMP(""XPDT"","_+XPDA_",""TEMP"")"
  1.  .;if using current transport global, run pre-transp routine and quit
  1.  .I $P(XPDA,U,3) S XPDA=+XPDA D PRET Q
  1.  .;if package file link then set XPDVER=version number^package name
  1.  .S XPDA=+XPDA,XPDVER=$S($P(^XPD(9.6,XPDA,0),U,2):$$VER^XPDUTL(XPDNM)_U_$$PKG^XPDUTL(XPDNM),1:"")
  1.  .;Inc the Build number
  1.  .S $P(^XPD(9.6,XPDA,6.3),U)=$G(^XPD(9.6,XPDA,6.3))+1
  1.  .K ^XTMP("XPDT",XPDA)
  1.  .;GLOBAL PACKAGE
  1.  .I $D(XPDGP) D  S XPDT=1 Q
  1.  ..;can't send global package in packman message
  1.  ..I $G(XPDTP) S XPDERR=1 Q
  1.  ..;verify global package
  1.  ..I '$$GLOPKG^XPDV(XPDA) S XPDERR=1 Q
  1.  ..;get Environment check and Post Install routines
  1.  ..F Y="PRE","INIT" I $G(^XPD(9.6,XPDA,Y))]"" S X=^(Y) D
  1.  ...S ^XTMP("XPDT",XPDA,Y)=X,X=$P(X,U,$L(X,U)),%=$$LOAD^XPDTA(X,"0^")
  1.  ..D BLD^XPDTC,PRET
  1.  .F X="DD^XPDTC","KRN^XPDTC","QUES^XPDTC","INT^XPDTC","BLD^XPDTC" D @X Q:$D(XPDERR)
  1.  .D:'$D(XPDERR) PRET
  1.  ;XPDTP - call ^XPDTP to build Packman message
  1.  I $G(XPDTP) S XPDA=+XPDT(XPDT) D ^XPDTP G QUIT
  1.  I $L(XPDH) D GO G QUIT
  1.  ;if no device then just create transport global
  1.  W !! F XPDT=1:1:XPDT W "Transport Global ^XTMP(""XPDT"","_+XPDT(XPDT)_") created for ",$P(XPDT(XPDT),U,2),!
  1.  Q
  1. DEV N FIL,DIR,IOP,X,Y,%ZIS W !
  1.  D HOME^%ZIS
  1.  S DIR(0)="F^3:245",DIR("A")="Enter a Host File",DIR("?")="Enter a filename and/or path to output package(s).",POP=0
  1.  D ^DIR I $D(DTOUT)!$D(DUOUT) S POP=1 Q
  1.  ;if no file, then quit
  1.  Q:Y=""  S FIL=Y
  1.  S DIR(0)="F^3:80",DIR("A")="Header Comment",DIR("?")="Enter a comment between 3 and 80 characters."
  1.  D ^DIR I $D(DIRUT) S POP=1 Q
  1.  S XPDH=Y,%ZIS="",%ZIS("HFSNAME")=FIL,%ZIS("HFSMODE")="W",IOP="HFS",(XPDSIZ,XPDSIZA)=0,XPDSEQ=1
  1.  D ^%ZIS I POP W !!,"**Incorrect Host File name**",!,$C(7) Q
  1.  ;write date and comment header
  1.  S XPDHD="KIDS Distribution saved on "_$$HTE^XLFDT($H)
  1.  U IO W $$SUM(XPDHD),!,$$SUM(XPDH),!
  1.  S XPDFMSG=1 ;Send mail to forum of routines in HFS.
  1.  ;U IO(0) is to insure I am writing to the terminal
  1.  U IO(0) Q
  1.  ;
  1. GO S I=1,Y="",XPDH1="**KIDS**:" U IO
  1.  ;Global Package, header is different and there is only 1 package
  1.  I $D(XPDGP) W $$SUM("**KIDS**GLOBALS:"_$P(XPDT(1),U,2)_U_XPDGP),! G GO1
  1.  ;write header that maintains package list, keep less than 255 char
  1.  F  D  W $$SUM(XPDH1_Y),! Q:I=XPDT  S Y="",I=I+1,XPDH1="**KIDS**"
  1.  .F I=I:1 S Y=Y_$P(XPDT(I),U,2)_"^" Q:$L(Y)>200!(I=XPDT)
  1.  ;after the package list write an extra line feed
  1. GO1 W ! S XPDSIZA=XPDSIZA+2
  1.  N XMSUB,XMY,XMTEXT
  1.  ;loop thru & write global, don't kill if set to permanent, set in XPDIU
  1.  F XPDT=1:1:XPDT S XPDA=+XPDT(XPDT),XPDNM=$P(XPDT(XPDT),U,2) D GW,XM K:'$G(^XTMP("XPDT",XPDA)) ^(XPDA)
  1.  W "**END**",!
  1.  ;GLOBAL PACKAGE there could only be one package, write globals
  1.  I $D(XPDGP) D GPW W "**END**",!
  1.  ;we're done with device, close it
  1.  W "**END**",! D ^%ZISC
  1.  W !!,"Package Transported Successfully",!
  1.  Q
  1. GW ;global write
  1.  N GR,GCK,GL
  1.  S GCK="^XTMP(""XPDT"","_XPDA,GR=GCK_")",GCK=GCK_",",GL=$L(GCK)
  1.  ;INSTALL NAME line will mark the beginning of global for all lines until
  1.  ;the next INSTALL NAME
  1.  W $$SUM("**INSTALL NAME**",1),!,$$SUM(XPDNM),!
  1.  F  Q:$D(DIRUT)  S GR=$Q(@GR) Q:GR=""!($E(GR,1,GL)'=GCK)  W $$SUM($P(GR,GCK,2),1),!,$$SUM(@GR),!
  1.  Q
  1. XM ;Send HFS checksum message
  1.  Q:'$G(XPDFMSG)
  1.  N XMTEXT,C,RN,RN2,X,X2
  1.  K ^TMP($J)
  1.  S XMSUB="**KIDS** Checksum for "_XPDNM,XMTEXT="^TMP($J)"
  1.  I $G(^XMB("NETNAME"))["VA.GOV" S XMY("S.A1AE HFS CHKSUM SVR@FORUM.VA.GOV")=""
  1.  E  S X=$$GET^XPAR("PKG","XPD PATCH HFS SERVER",1,"Q") S:$L(X) XMY(X)=""
  1.  I '$D(XMY) Q  ;No one to send it to.
  1.  S C=1,@XMTEXT@(1,0)="~~1:"_XPDNM
  1.  I XPDT=1,$O(XPDT(1)) D
  1.  . S RN=1 F  S RN=$O(XPDT(RN)) Q:'RN  S C=C+1,@XMTEXT@(C,0)="~~2:"_$P(XPDT(RN),"^",2)
  1.  S (RN,RN2)="" ;Send full RTN node
  1.  F  S RN=$O(^XTMP("XPDT",XPDA,"RTN",RN)) Q:'$L(RN)  S X=^(RN),X2=$G(^(RN,2,0)) D
  1.  . S C=C+1,@XMTEXT@(C,0)="~~3:"_RN_"^"_X_"^"_$P(X2,";",5)
  1.  . I RN2="",$E(X2,1,3)=" ;;" S RN2=$P(X2,"**",1)_"**[Patch List]**"_$P(X2,"**",3)
  1.  S C=C+1,@XMTEXT@(C,0)="~~4:"_RN2
  1.  S C=C+1,@XMTEXT@(C,0)="~~8:"_$G(^XMB("NETNAME"))
  1.  S C=C+1,@XMTEXT@(C,0)="~~9:Save"
  1.  S XMTEXT="^TMP($J,"
  1.  D ^XMD
  1.  Q
  1. GPW ;global package write
  1.  N I,G,GR,GCK,GL
  1.  W !
  1.  F I=1:1 S G=$P(XPDGP,U,I) Q:G=""  D
  1.  .S GR="^"_$P(G,";",2),GCK=$S(GR[")":$E(GR,1,$L(GR)-1)_",",1:GR_"("),GL=$L(GCK)
  1.  .;GLOBAL line will mark the beginning of global for all lines until
  1.  .;the next GLOBAL
  1.  .W $$SUM("**GLOBAL**",1),!,$$SUM(GR),!
  1.  .F  Q:$D(DIRUT)  S GR=$Q(@GR) Q:GR=""!($E(GR,1,GL)'=GCK)  W $$SUM($P(GR,GCK,2),1),!,$$SUM(@GR),!
  1.  Q
  1. QUIT F XPDT=1:1:XPDT L -^XPD(9.6,+XPDT(XPDT))
  1.  Q
  1. ABORT W !!,"**TRANSPORT ABORTED**",*7
  1.  D QUIT
  1.  F XPDT=1:1:XPDT K ^XTMP("XPDT",+XPDT(XPDT))
  1.  ;if HF, save file name IO into XPDH
  1.  S:$L(XPDH) XPDH=IO
  1.  D ^%ZISC
  1.  ;if HF, then delete file
  1.  I $L(XPDH),$$DEL1^%ZISH(XPDH) W !,"File:  ",XPDH,"  (Deleted)"
  1.  Q
  1.  ;
  1. PCK(XPDA,XPDNM,XPDREQ) ;XPDA=Build ien, XPDNM=Build name, XPDREQ=Required
  1.  N Y
  1.  S XPDT=XPDT+1,XPDT(XPDT)=XPDA_U_XPDNM,XPDT("DA",XPDA)=XPDT
  1.  S:'$G(XPDREQ) XPDREQ=0
  1.  S $P(XPDT(XPDT),U,4)=XPDREQ
  1.  Q:'$D(^XTMP("XPDT",XPDA))  S Y=$G(^(XPDA))
  1.  W "     **Transport Global exists**"
  1.  ;Y=1 if TG is permanent
  1.  I Y S $P(XPDT(XPDT),U,3)=1 Q
  1.  ;ask if they want to use TG
  1.  D ^DIR S $P(XPDT(XPDT),U,3)=Y
  1.  Q
  1.  ;
  1. SUM(X,Z) ;X=string to write, Z 0=don't check size
  1.  S XPDSIZA=XPDSIZA+$L(X)+2
  1.  Q X
  1.  ;
  1. PAH(XPDA) ;check for PATCH APPLICATION HISTORY in Package file
  1.  N Y,Z
  1.  S Y=^XPD(9.6,XPDA,0),Z=$$VER^XPDUTL($P(Y,U))
  1.  ;Single Package, Version multiple, PAH multiple
  1.  I $P(Y,U,3)=0,$D(^DIC(9.4,+$P(Y,U,2),22)),Z S Z=$O(^(22,"B",Z,0)) I Z,$O(^DIC(9.4,+$P(Y,U,2),22,Z,"PAH",0)) Q 1
  1.  Q 0
  1.  ;
  1. PRET ;Pre-Transport Routine
  1.  N Y,Z
  1.  S Y=$G(^XPD(9.6,XPDA,"PRET")) Q:Y=""
  1.  I '$$RTN^XPDV(Y,.Z) W !!,"Pre-Transportation Routine ",Y,Z,*7 Q
  1.  S Y=$S(Y["^":Y,1:"^"_Y) W !,"Running Pre-Transportation Routine ",Y
  1.  D @Y Q
  1.  ;
  1.  ;
  1.  ;FROM DEV
  1.  ;if MSM and HFS file is on device A or B, then get size for floppy disk
  1.  ;XPDSIZ=disk size, XPDSIZA=accummulated size,XPDSEQ=disk sequence number
  1.  I ^%ZOSF("OS")["MSM",FIL?1(1"A",1"B")1":"1.E D  Q:POP
  1.  .S DIR(0)="N^0:5000",DIR("A")="Size of Diskette (1K blocks)",DIR("B")=1400,DIR("?")="Enter the number of 1K blocks which each diskette will hold, 0 means unlimited space"
  1.  .D ^DIR I $D(DIRUT) S POP=1 Q
  1.  .S XPDSIZ=$S(Y:Y*1024,1:0)
  1.  ;FROM SUM
  1.  ;ask for next disk
  1.  ;this code is for MSM system only
  1.  I $G(Z),XPDSIZ,XPDSIZ-XPDSIZA<1024 D
  1.  .;write continue flag at end of this file
  1.  .W "**CONTINUE**",!,"**END**",!
  1.  .;should call %ZIS HFS utilities to close and open file
  1.  .X "C IO" U IO(0)
  1.  .N DIR,G,GR,GCK,GL,I,X,Y
  1.  .W !!,"Diskette #",XPDSEQ," is full."
  1.  .S DIR(0)="E",DIR("A")="Insert the next diskette and Press the return key",DIR("?")="The current diskette is full, insert a new diskette to continue."
  1.  .;$D(DIRUT)=the user aborted the distribution
  1.  .D ^DIR I $D(DIRUT) D ABORT Q
  1.  .W ! S XPDSEQ=XPDSEQ+1,XPDSIZA=0
  1.  .;MSM specific code to open HFS
  1.  .X "O IO:IOPAR" U IO
  1.  .W $$SUM("Continuation #"_XPDSEQ_" of "_XPDHD),!,$$SUM(XPDH),!,$$SUM("**SEQ**:"_XPDSEQ),!!
  1.  .S XPDSIZA=XPDSIZA+2