XBGSAVE ; IHS/ADC/GTH - GENERIC GLOBAL SAVE FOR TRANSMISSION GLOBALS ; [ 07/21/2005 4:13 PM ] ;;4.0;XB;;Jul 20, 2009;Build 2 ;XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods. ; ; XBGL = name of global (mandatory, all others optional) ; ; XBCON= if defined, stops if first-level subscript is non-cannonic ; XBDT = date of save, in FM format, default NOW ; XBE = ending first-level numeric subscript ; XBFLT= 1, saves as flat file ; XBFN = output file name, default "." ; XBF = beginning first-level numeric subscript, seed for $ORDER ; XBIO = output device number ; XBMED= media to which to save global (user asked, if not exist) ; XBNAR= description displayed to user, if user asks for help ; XBPAR= CR parameter (DSM only) ; XBQ = Y/N, to place file in uucp q, default "Y" ; XBQTO= 'sendto' destination, default AO sysid in RPMS SITE file ; XBTLE= comment for dump header (facility name is concatenated) ; XBUF = directory, default no longer provided - will kick out error ; if XBUF undefined and no directory found in files ; 9999999.39 or 8989.3 ; XBS1 = zish send paramaters file entry ; SETUP ; I '$D(^%ZOSF("OS")) S XBFLG(1)="The ^%ZOSF(""OS"") node does not exist",XBFLG=-1 G EOJ ; I '(^%ZOSF("OS")["MSM"),'(^%ZOSF("OS")["DSM") S XBFLG(1)="Operating system is not 'MSM' or 'DSM'",XBFLG=-1 G EOJ ; IHS/SET/GTH XB*3*9 10/29/2002 I '(^%ZOSF("OS")["MSM"),'(^%ZOSF("OS")["OpenM") S XBFLG(1)="Operating system is not 'MSM' or 'Cache'",XBFLG=-1 G EOJ ; IHS/SET/GTH XB*3*9 10/29/2002 I '$G(DUZ(2)) S XBFLG(1)="Facility Number 'DUZ(2)' is not defined",XBFLG=-1 G EOJ I '$D(XBGL) S XBFLG(1)="The variable 'XBGL' must contain the name of the global you wish to save." S XBFLG=-1 G EOJ KILL XBFLG,XBGLL S:'$D(DTIME) DTIME=300 CHECK ; S X=XBGL I $L(X,"(")>1,$P(X,"(",2)="" S X=$P(X,"(") S:$E(X,$L(X))="," X=$E(X,1,($L(X)-1)) I $L(XBGL,"(")>1,$E(XBGL,$L(XBGL))'="," S XBGL=XBGL_"," I $L(X,"(")>1,$E(X,$L(X))'=")" S X=X_")" S:$L(X,"(")=1 XBGL=X_"(" S XBGLL=U_X CKGLOB ; I '$D(@XBGLL) S XBFLG(1)="Transaction File does not exist",XBFLG=-1 G EOJ ;S:'$D(XBUF) XBUF="/usr/spool/uucppublic" I $G(XBUF)="" S XBUF=$P($G(^AUTTSITE(1,1)),"^",2) I XBUF="" S XBUF=$P($G(^XTV(8989.3,1,"DEV")),"^",1) I XBUF="" D G EOJ .S XBFLG(1)="Export Directory NOT Specified" .S XBFLG=-1 I "/\"[$E(XBUF,$L(XBUF)) D .S XBUF=$E(XBUF,1,($L(XBUF)-1)) I '$D(DT) D DT^DICRW S X2=$E(DT,1,3)_"0101",X1=DT D ^%DTC S XBCARTNO=X+1,XBDT=$S($D(XBDT):$$FMTE^XLFDT(XBDT),1:$$HTE^XLFDT($H)) S:$E(XBGL)'=U XBGL=U_XBGL S XBNAR=$G(XBNAR),XBTLE=$G(XBTLE)_" "_$P(^DIC(4,DUZ(2),0),U) I $D(XBMED) S XBMED=$$UP^XLFSTR($E(XBMED)) S XBQ=$E($G(XBQ)_"Y") I XBQ="Y" S XBQTO=$G(XBQTO) I XBQTO="" S XBQTO=$P(^AUTTSITE(1,0),U,14) I XBQTO="" S XBQ="N" S XBF=$G(XBF),XBE=$G(XBE) I XBF="" S XBF="""""" I ^%ZOSF("OS")["DSM" G SETUPDSM SETUPMSM ; S:'$D(XBIO) XBIO=51 I $D(XBMED),'("CDFT"[XBMED) S XBFLG(1)="Media Type '"_XBMED_"' is incorrect",XBFLG=-1 G EOJ D ^ZIBGSVEM I $G(XBS1)'="" D .S XBFLG=$$SENDTO1^ZISHMSMU(XBS1,XBPAFN) .S XBFLG(1)=$P(XBFLG,"^",2) .S XBFLG=+XBFLG .Q:$D(ZTQUEUED) .W:XBFLG=0 !!,"File was sent successfully" .W:'(XBFLG=0) !!,"File was **NOT** sent successfully" G EOJ ; SETUPDSM ; I '$D(XBIO) S XBIO=47 I $D(XBMED),'("CT"[XBMED) S XBFLG(1)="Media Type '"_XBMED_"' is incorrect",XBFLG=-1 G EOJ D ^ZIBGSVED EOJ ; S:'$D(XBFLG) XBFLG=0 KILL %DT,X,XBCON,XBFN,XBGL,XBGLL,XBCARTNO,X1,X2,XBNAR,XBTLE,XBIO,XBPAR,XBDT,XBE,XBF,XBMED,XBUF,XBQ,XBQTO,XBFLT,XBSUFAC,Y Q ;