XPDIPM ;SFISC/RSD - Load a Packman Message ;05/05/2008
;;8.0;KERNEL;**21,28,68,108,755**;Jul 05, 1995;Build 6
Q:'$D(^XMB(3.9,+$G(XMZ),0))
N X,XPD,Y S XPD=0
F S XPD=$O(^XMB(3.9,XMZ,2,XPD)) Q:+XPD'=XPD S X=^(XPD,0) I $E(X,1,11)="$TXT $KIDS " Q
S Y=$P(X,"$KIDS ",2)
EN I 'XPD!'$L(Y) W !!,"Couldn't find a KIDS package!!",*7 Q
N DIR,DIRUT,GR,XPDA,XPDST,XPDIT,XPDT,XPDNM,XPDQUIT,XPDREQAB
S XPDST("H1")=$P(^XMB(3.9,XMZ,0),U),XPDST=0,XPDIT=1
S XPDA=$$INST^XPDIL1(Y) G:'XPDA NONE^XPDIL
W !,"Distribution OK!",! ;p755
S DIR(0)="Y",DIR("A")="Want to Continue with Load",DIR("B")="YES"
;p345-rename AND* to XPD*-Patch was Cancelled keep code for future.
I '$G(XPDAUTO) D ^DIR S:$G(XPDAUTO) Y=1 I 'Y!$D(DIRUT) D ABRTALL^XPDI(1) G NONE^XPDIL
W !,"Loading Distribution...",!
S ^XTMP("XPDI",0)=$$FMADD^XLFDT(DT,7)_U_DT
D GI I $G(XPDQUIT) D ABRTALL^XPDI(1) G NONE^XPDIL
D PKG^XPDIL1(XPDA)
Q
GI D NXT Q:$G(XPDQUIT)
I X'="**INSTALL NAME**"!'$D(XPDT("NM",Y)) S XPDQUIT=1 Q
S GR="^XTMP(""XPDI"","_XPDA_","
F D NXT Q:X=""!$D(XPDQUIT) D
.S @(GR_X)=Y
Q
NXT S (X,Y)="",XPD=$O(^XMB(3.9,XMZ,2,XPD)) G:+XPD'=XPD ERR S X=^(XPD,0)
I $E(X,1,5)="$END " S X="" Q
S XPD=$O(^XMB(3.9,XMZ,2,XPD)) G:+XPD'=XPD ERR
S Y=^XMB(3.9,XMZ,2,XPD,0)
Q
XMP2 ;called from XMP2
N X,XPD,Y
S XPD=XCN,X=$G(^XMB(3.9,XMZ,2,XPD,0)),Y=$P(X,"$KID ",2)
D EN
S XMOUT=1
Q
ERR W !!,"Error in Packman Message, ABORTING load!!"
S (X,Y)="",XPDQUIT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDIPM 1463 printed Dec 13, 2024@02:04:16 Page 2
XPDIPM ;SFISC/RSD - Load a Packman Message ;05/05/2008
+1 ;;8.0;KERNEL;**21,28,68,108,755**;Jul 05, 1995;Build 6
+2 if '$DATA(^XMB(3.9,+$GET(XMZ),0))
QUIT
+3 NEW X,XPD,Y
SET XPD=0
+4 FOR
SET XPD=$ORDER(^XMB(3.9,XMZ,2,XPD))
if +XPD'=XPD
QUIT
SET X=^(XPD,0)
IF $EXTRACT(X,1,11)="$TXT $KIDS "
QUIT
+5 SET Y=$PIECE(X,"$KIDS ",2)
EN IF 'XPD!'$LENGTH(Y)
WRITE !!,"Couldn't find a KIDS package!!",*7
QUIT
+1 NEW DIR,DIRUT,GR,XPDA,XPDST,XPDIT,XPDT,XPDNM,XPDQUIT,XPDREQAB
+2 SET XPDST("H1")=$PIECE(^XMB(3.9,XMZ,0),U)
SET XPDST=0
SET XPDIT=1
+3 SET XPDA=$$INST^XPDIL1(Y)
if 'XPDA
GOTO NONE^XPDIL
+4 ;p755
WRITE !,"Distribution OK!",!
+5 SET DIR(0)="Y"
SET DIR("A")="Want to Continue with Load"
SET DIR("B")="YES"
+6 ;p345-rename AND* to XPD*-Patch was Cancelled keep code for future.
+7 IF '$GET(XPDAUTO)
DO ^DIR
if $GET(XPDAUTO)
SET Y=1
IF 'Y!$DATA(DIRUT)
DO ABRTALL^XPDI(1)
GOTO NONE^XPDIL
+8 WRITE !,"Loading Distribution...",!
+9 SET ^XTMP("XPDI",0)=$$FMADD^XLFDT(DT,7)_U_DT
+10 DO GI
IF $GET(XPDQUIT)
DO ABRTALL^XPDI(1)
GOTO NONE^XPDIL
+11 DO PKG^XPDIL1(XPDA)
+12 QUIT
GI DO NXT
if $GET(XPDQUIT)
QUIT
+1 IF X'="**INSTALL NAME**"!'$DATA(XPDT("NM",Y))
SET XPDQUIT=1
QUIT
+2 SET GR="^XTMP(""XPDI"","_XPDA_","
+3 FOR
DO NXT
if X=""!$DATA(XPDQUIT)
QUIT
Begin DoDot:1
+4 SET @(GR_X)=Y
End DoDot:1
+5 QUIT
NXT SET (X,Y)=""
SET XPD=$ORDER(^XMB(3.9,XMZ,2,XPD))
if +XPD'=XPD
GOTO ERR
SET X=^(XPD,0)
+1 IF $EXTRACT(X,1,5)="$END "
SET X=""
QUIT
+2 SET XPD=$ORDER(^XMB(3.9,XMZ,2,XPD))
if +XPD'=XPD
GOTO ERR
+3 SET Y=^XMB(3.9,XMZ,2,XPD,0)
+4 QUIT
XMP2 ;called from XMP2
+1 NEW X,XPD,Y
+2 SET XPD=XCN
SET X=$GET(^XMB(3.9,XMZ,2,XPD,0))
SET Y=$PIECE(X,"$KID ",2)
+3 DO EN
+4 SET XMOUT=1
+5 QUIT
ERR WRITE !!,"Error in Packman Message, ABORTING load!!"
+1 SET (X,Y)=""
SET XPDQUIT=1
+2 QUIT
