[613] | 1 | XPDIPM ;SFISC/RSD - Load a Packman Message ;05/28/99 10:08
|
---|
| 2 | ;;8.0;KERNEL;**21,28,68,108**;Jul 05, 1995
|
---|
| 3 | Q:'$D(^XMB(3.9,+$G(XMZ),0))
|
---|
| 4 | N X,XPD,Y S XPD=0
|
---|
| 5 | 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
|
---|
| 6 | S Y=$P(X,"$KIDS ",2)
|
---|
| 7 | EN I 'XPD!'$L(Y) W !!,"Couldn't find a KIDS package!!",*7 Q
|
---|
| 8 | N DIR,DIRUT,GR,XPDA,XPDST,XPDIT,XPDT,XPDNM,XPDQUIT,XPDREQAB
|
---|
| 9 | S XPDST("H1")=$P(^XMB(3.9,XMZ,0),U),XPDST=0,XPDIT=1
|
---|
| 10 | S XPDA=$$INST^XPDIL1(Y) G:'XPDA NONE^XPDIL
|
---|
| 11 | W !
|
---|
| 12 | S DIR(0)="Y",DIR("A")="Want to Continue with Load",DIR("B")="YES"
|
---|
| 13 | D ^DIR I 'Y!$D(DIRUT) D ABRTALL^XPDI(1) G NONE^XPDIL
|
---|
| 14 | W !,"Loading Distribution...",!
|
---|
| 15 | S ^XTMP("XPDI",0)=$$FMADD^XLFDT(DT,7)_U_DT
|
---|
| 16 | D GI I $G(XPDQUIT) D ABRTALL^XPDI(1) G NONE^XPDIL
|
---|
| 17 | D PKG^XPDIL1(XPDA)
|
---|
| 18 | Q
|
---|
| 19 | GI D NXT Q:$G(XPDQUIT)
|
---|
| 20 | I X'="**INSTALL NAME**"!'$D(XPDT("NM",Y)) S XPDQUIT=1 Q
|
---|
| 21 | S GR="^XTMP(""XPDI"","_XPDA_","
|
---|
| 22 | F D NXT Q:X=""!$D(XPDQUIT) D
|
---|
| 23 | .S @(GR_X)=Y
|
---|
| 24 | Q
|
---|
| 25 | NXT S (X,Y)="",XPD=$O(^XMB(3.9,XMZ,2,XPD)) G:+XPD'=XPD ERR S X=^(XPD,0)
|
---|
| 26 | I $E(X,1,5)="$END " S X="" Q
|
---|
| 27 | S XPD=$O(^XMB(3.9,XMZ,2,XPD)) G:+XPD'=XPD ERR
|
---|
| 28 | S Y=^XMB(3.9,XMZ,2,XPD,0)
|
---|
| 29 | Q
|
---|
| 30 | XMP2 ;called from XMP2
|
---|
| 31 | N X,XPD,Y
|
---|
| 32 | S XPD=XCN,X=$G(^XMB(3.9,XMZ,2,XPD,0)),Y=$P(X,"$KID ",2)
|
---|
| 33 | D EN
|
---|
| 34 | S XMOUT=1
|
---|
| 35 | Q
|
---|
| 36 | ERR W !!,"Error in Packman Message, ABORTING load!!"
|
---|
| 37 | S (X,Y)="",XPDQUIT=1
|
---|
| 38 | Q
|
---|