TMGXPDIL ;TMG/kst/Custom version of XPDIL ;09/17/08 ;;1.0;TMG-LIB;**1**;09/17/08 ;"Original header.... ;"XPDIL ;SFISC/RSD - load Distribution Global ;05/28/99 09:41 ;" ;;8.0;KERNEL;**15,44,58,68,108**;Jul 10, 1995 ; ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"9/17/08 EN1(Option,Msg) ;"Purpose: Provide an API for KIDS load a distribution ;"Input: Option -- PASS BY REFERENCE. Entries are required unless marked optional ;" Option("HFSNAME")=FilePathNameOnHFS ;" Option("FORCE CONT LOAD")=1 <-- if not given, then load won't continue ;" Option("DO ENV CHECK")=# 1=do check, 0=don't do check ;" Option("VERBOSE")=1 for output ;" Msg -- PASS BY REFERANCE, an OUT PARAMETER ;" Errors are stored in Msg("ERROR",x)=Message ;" Msg("ERROR")=count of last error ;" Message are store in Msg(x)=Message ;" Msg=count of last message+1 ;"Output: Option -- Option("INSTALL NAME")=Name to use to install package N POP,XPDA,XPDST,XPDIT,XPDT,XPDGP,XPDQUIT,XPDREQAB,XPDSKPE S:'$D(DT) DT=$$DT^XLFDT S:'$D(U) U="^" S XPDST=0 set Msg=+$get(Msg,1) new temp set temp=$$ST(.Option,.Msg) ;"Load in patch if (temp=0)!($G(XPDQUIT)) do goto EnDone . D ABRTALL^TMGXPDI(1,,.Msg) ;"(not interactive) . do AddMsg^TMGPAT2("**NOTHING LOADED**",1,.Msg) ;"XPDST= starting Build ;"XPDT("DA",ien)=seq # to install ;"XPDT("NM",build name)=seq # ;"XPDT(seq #)=ien^Build name ;"XPDT("GP",global)= 1-replace, 0-overwrite^ien ;"XPDGP=globals from a Global Package ;"XPDSKPE=1 don't run Environment Check^has question been asked S XPDIT=0,XPDSKPE="0^0" F S XPDIT=$O(XPDT(XPDIT)) Q:'XPDIT D Q:'$D(XPDT) . S XPDA=+XPDT(XPDIT) . if $$CheckLocal^TMGPAT4($name(^XTMP("XPDI",XPDA)),.Option)=1 do . . ;"if $get(Option("VERBOSE"))'=1 quit . . write "WARNING. This code overwrites local mods!",! . . do PressToCont^TMGUSRIF . ;"Check if this Build has an Envir. Check . I $G(^XTMP("XPDI",XPDA,"PRE"))]"" D . . ;"Quit if we already asked this question . . Q:$P(XPDSKPE,U,2) . . S $P(XPDSKPE,U,2)=1 . . set Y=$get(Option("DO ENV CHECK")) . . if Y'=1 set XPDSKPE="1^1" . I $G(XPDQUIT) D ABRTALL^TMGXPDI(1,,.Msg) Q . D PKG^TMGXPDL1(XPDA,.Option,.Msg) ;"Global Package G:$D(XPDGP) ^XPDIGP I $D(XPDT),$D(^XPD(9.7,+XPDST,0)) do . do AddMsg^TMGPAT2("Use INSTALL NAME: "_$P(^(0),U)_" to install this Distribution.",0,.Msg) . set Option("INSTALL NAME")=$P(^(0),U) EnDone Q ST(Option,Msg) ;"Purpose: 'global input' ;"Input: Option -- PASS BY REFERENCE. Entries are required unless marked optional ;" Option("HFSNAME")=FilePathNameOnHFS ;" Option("FORCE CONT LOAD")=1 <-- if not given, then load won't continue ;" Option("INTERACTIVE")=1 if 1 then direct user input asked if needed ;" Msg -- PASS BY REFERENCE, an OUT PARAMETER. ;" Errors are stored in Msg("ERROR",x)=Message ;" Msg("ERROR")=count of last error ;" Message are store in Msg(x)=Message ;" Msg=count of last message+1 ;"Results: 1=success, 0=error new result set result=1 N DIR,DIRUT,GR,IOP,X,Y,Z,%ZIS I '$D(^%ZIS(1,"B","HFS")) do goto STDone . do AddMsg^TMGPAT2("You must have a device called 'HFS' in order to load a distribution!",1,.Msg) . S XPDQUIT=1 D HOME^%ZIS set Y=$get(Option("HFSNAME")) if (Y="")&($get(Option("INTERACTIVE"))=1) do . set DIR("A")="Enter a Host File",DIR("?")="Enter a filename and/or path to input Distribution." . set Y=$$GetFName^TMGIOUTL(DIR("?"),"/tmp/","","","","",DIR("A")_": ") if Y="" do goto STDone . do AddMsg^TMGPAT2("No host file system filename provided!",1,.Msg) . S XPDQUIT=1 S %ZIS="",%ZIS("HFSNAME")=Y,%ZIS("HFSMODE")="R",IOP="HFS" D ^%ZIS I POP do . do AddMsg^TMGPAT2("Couldn't open file or HFS device!!",1,.Msg) . set result=0 ;"don't close device if we have a global package, we need to bring in the globals now D GI(.Option,.Msg) ;"Get file loaded in do ^%ZISC:'$D(XPDGP)!$G(XPDQUIT) STDone if $get(XPDQUIT)=1 set result=0 Q result GI(Option,Msg) ;"Get In ;"Purpose: Open file and load in. ;"Input: Option -- PASS BY REFERENCE. Entries are required unless marked optional ;" Option("HFSNAME")=FilePathNameOnHFS ;" Option("FORCE CONT LOAD")=1 <-- if not given, then load won't continue ;" Msg -- PASS BY REFERENCE, an OUT PARAMETER. ;" Errors are stored in Msg("ERROR",x)=Message ;" Msg("ERROR")=count of last error ;" Message are store in Msg(x)=Message ;" Msg=count of last message+1 N X,XPDSEQ,Y,Z U IO ;"open KIDS text file for input do DoRead(.X,1) do DoRead(.Y,1) do AddMsg^TMGPAT2(X,0,.Msg) do AddMsg^TMGPAT2("Comment: "_Y,0,.Msg) S XPDST("H")=Y if Y="Extracted from mail message" do . S XPDST("H1")=X else do . S XPDST("H1")=Y_" ;Created on "_$P(X,"KIDS Distribution saved on ",2) ;"Z is the string of Builds in this file F X=1:1 do Q:Z="" . do DoRead(.Z,1) . S Z=$P(Z,"**KIDS**",2,99) . Q:Z="" . S X(X)=Z U IO(0) I $G(X(1))="" do goto GIDone . do AddMsg^TMGPAT2("This is not a Distribution HFS File!",1,.Msg) . S XPDQUIT=1 ;"global package, set XPDGP=flag;global^flag;global^... flag=1 replace I $P(X(1),":")="GLOBALS" S XPDGP=$P(X(1),U,2,99),X(1)=$P(X(1),U) S XPDIT=0,X(1)=$P(X(1),":",2,99) do AddMsg^TMGPAT2("This Distribution contains Transport Globals for the following Package(s):",0,.Msg) kill XPDQUIT F X=1:1:X-1 do Q:$get(XPDQUIT)=1 . F Z=1:1 do Q:(Y="")!($get(XPDQUIT)=1) . . S Y=$P(X(X),U,Z) . . Q:Y="" . . ;"can't install if global exist, that means Build never finish install . . ;"INST will show name . . S XPDIT=XPDIT+1 . . new temp set temp=$$INST^TMGXPDL1(Y,.Option,.Msg) . . ;" //kt removed I temp=0 S XPDQUIT=1 Q if $G(XPDQUIT) goto GIDone do AddMsg^TMGPAT2("Distribution OK",0,.Msg) if $D(XPDGP) do DISP^TMGXPDIG(Msg) if $get(Option("FORCE CONT LOAD"))'=1 do goto GIDone . do AddMsg^TMGPAT2("Option(""FORCE CONT LOAD"")=1 not found in passed options.",1,.Msg) . S XPDQUIT=1 do AddMsg^TMGPAT2("Loading Distribution...",0,.Msg) ;"reset expiration date to T+7 on transport global S ^XTMP("XPDI",0)=$$FMADD^XLFDT(DT,7)_U_DT ;"start reading the HFS again U IO do DoRead(.X,0) do DoRead(.Y,0) ;"R X:0,Y:0 ;"the next read must be the INSTALL NAME I X'="**INSTALL NAME**"!'$D(XPDT("NM",Y)) do goto GIDone . do AddMsg^TMGPAT2("ERROR in HFS file format!",1,.Msg) . S XPDQUIT=1 ;"XPDSEQ is the disk sequence number S %=XPDT("NM",Y) set GR="^XTMP(""XPDI"","_+XPDT(%)_"," set XPDSEQ=1 ;"X=global ref, Y=global value. F do DoRead(.X,0) Q:X="**END**" D I $D(DIRUT) S XPDQUIT=1 Q . do DoRead(.Y,0) . I X="**INSTALL NAME**" D Q . . S %=+$G(XPDT("NM",Y)) . . set GR="" ;"//kt added Allows ignoring parts of multipatch not needed . . ;"I '% S DIRUT=1 Q ;"//kt . . I '% Q ;"//kt . . S GR="^XTMP(""XPDI"","_+XPDT(%)_"," . if GR'="" S @(GR_X)=Y U IO(0) GIDone Q DoRead(S,timeOut) ;"Purpose: Do Read, but strip trailling #13 if needed. ;"Input: S -- pass by reference, and OUT PARAMETER ;" timeOut -- time out var to pass to READ command ;"Results: none read S:timeOut new l set l=$length(S) new ch set ch=$ascii($extract(S,l)) if ch=13 set S=$extract(S,1,l-1) quit NEXTD I ^%ZOSF("OS")'["MSM" U IO(0) W !!,"Error in disk, ABORTING load!!" S XPDQUIT=1 Q N DIR ;"close current device C IO U IO(0) S XPDSEQ=XPDSEQ+1,DIR(0)="E" S DIR("A")="Insert the next diskette, #"_XPDSEQ_", and Press the return key" S DIR("?")="This distribution is continued on another diskette" D ^DIR Q:$D(DIRUT) W " OK",! ;MSM specific code to open HFS O @(""""_IO_""":"_IOPAR) U IO ;"R X:0,Y:0 do DoRead(.X,1) do DoRead(.Y,1) ;"quit if comments are not the same on each diskette G:Y'=XPDST("H") NEXTQ ;"quit if not the expected sequence, Z is for the blank line ;"R Y:0,Z:0 do DoRead(.Y,1) do DoRead(.Z,1) G:Y'=("**SEQ**:"_XPDSEQ) NEXTQ Q ; NEXTQ U IO(0) W !!,"This is NOT the correct diskette!! The comment on this diskette is:",!,X,!! S XPDSEQ=XPDSEQ-1 G NEXTD ; NONE W !!,"**NOTHING LOADED**",! Q USER ;"Purpose: Ask user questions questions before running silent EN1^TMGXPDIL new Options new Option,Msg new DIR set DIR("A")="Enter a Host File" set DIR("?")="Enter a filename and/or path to input Distribution." if $get(TMGPATNM)'="" set Y=TMGPATNM ;"allow preset file name set Option("HFSNAME")=$$GetFName^TMGIOUTL(DIR("?"),"/tmp/","","","","",DIR("A")_": ") new % set %=2 write "Do Environmental check" do YN^DICN write ! if %=-1 goto UDone set Option("DO ENV CHECK")=(%=1) set %=1 write "Force continue load" do YN^DICN write ! if %=-1 goto UDone set Option("FORCE CONT LOAD")=(%=1) do EN1(.Option,.Msg) if $data(Msg) zwr Msg UDone