XPDIPM.m

XPDIPM ;SFISC/RSD - Load a Packman Message ;05/28/99  10:08 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;8.0;KERNEL;**21,28,68,108**;Jul 05, 1995

 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 !

 S DIR(0)="Y",DIR("A")="Want to Continue with Load",DIR("B")="YES"

 D ^DIR 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

XPDIPM    ;SFISC/RSD - Load a Packman Message ;05/28/99  10:08 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;**21,28,68,108**;Jul 05, 1995

 +3        IF '$DATA(^XMB(3.9,+$GET(XMZ),0))

               QUIT 

 +4        NEW X,XPD,Y

           SET XPD=0

 +5        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 

 +6        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        WRITE !

 +5        SET DIR(0)="Y"

           SET DIR("A")="Want to Continue with Load"

           SET DIR("B")="YES"

 +6        DO ^DIR

           IF 'Y!$DATA(DIRUT)

               DO ABRTALL^XPDI(1)

               GOTO NONE^XPDIL

 +7        WRITE !,"Loading Distribution...",!

 +8        SET ^XTMP("XPDI",0)=$$FMADD^XLFDT(DT,7)_U_DT

 +9        DO GI

           IF $GET(XPDQUIT)

               DO ABRTALL^XPDI(1)

               GOTO NONE^XPDIL

 +10       DO PKG^XPDIL1(XPDA)

 +11       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