- 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 Feb 18, 2025@23:30:42 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
