Return to DIFGO.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFGO.m, revision 1.1

1.1     ! snw         1: DIFGO  ;SFISC/XAK-FILEGRAM OPTIONS ;2/24/93  10:58 ;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994;
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: 0      S DIC="^DOPT(""DIFG"","
        !             5:        G OPT:$D(^DOPT("DIFG",6)) S ^(0)="FILEGRAM OPTION^1.01" K ^("B")
        !             6:        F X=1:1:6 S ^DOPT("DIFG",X,0)=$P($T(@X),";;",2)
        !             7:        S DIK=DIC D IXALL^DIK
        !             8: OPT    ;
        !             9:        S DIC(0)="AEQIZ" D ^DIC G Q:Y<0 S DI=+Y D EN G 0
        !            10:        ;
        !            11: EN     ;Entry point for all filegram options
        !            12:        S DIC("S")="I Y>1.99" D:DI#2 ^DICRW G:Y<0 Q K DIC("S") ;ihs/ohprd/dg 8-21-91
        !            13:        D @DI W !!
        !            14: Q      K %,DIC,DIK,DI,DA,I,J,X,Y Q
        !            15:        ;
        !            16: 1      ;;CREATE/EDIT FILEGRAM TEMPLATE
        !            17:        G EN^DIFGA
        !            18:        ;
        !            19: 2      ;;DISPLAY FILEGRAM TEMPLATE
        !            20:        S DIC("A")="Select FILEGRAM TEMPLATE: "
        !            21:        S DIC="^DIPT(",DIC(0)="QEAM",DIC("S")="I $P(^(0),U,8)=1" D ^DIC I Y<0 K DIC Q
        !            22:        W !! S DA=+Y,DIQ(0)="C" D EN^DIQ K DIC,DIQ G 2
        !            23:        Q
        !            24:        ;
        !            25: 3      ;;GENERATE FILEGRAM
        !            26:        I '($D(IO)#2) D HOME^%ZIS
        !            27:        I DUZ'>0 W $C(7),!!,"INVALID USER.  YOU CAN'T USE THIS OPTION." Q
        !            28:        S DIC=+Y G ^DIFGG
        !            29:        ;
        !            30:        ;
        !            31: 4      ;;VIEW FILEGRAM
        !            32:        W !! S DIC(0)="ZQEAMIN",DIC=1.12 D ^DIC Q:Y<0  S IOP="HOME" D ^%ZIS Q:POP
        !            33:        S D0=+Y D EN1 G 4
        !            34: EN1    S X=Y(0),Y=$P(X,U,6),Y=$S($D(^XMB(3.9,+Y,0))#2:$P(^(0),U),1:Y) W !!,Y
        !            35:        S Y=$P(X,U,2) W !,$S(Y="s":"Sent",Y="i":"Installed",1:Y)
        !            36:        W " on " S Y=$P(X,U) D DT W " by ",$P(X,U,3)
        !            37:        S DIWL=1,DIWR=78,DIWF="WN" S D0=$P(X,U,6) S:'$D(^XMB(3.9,+D0,0)) D0=-1
        !            38:        W !! S S=5,D=0 F  S (D,D1)=$O(^XMB(3.9,D0,2,D)) Q:D'>0  I $D(^(D,0))#2 S X=^(0) D ^DIWP Q:'$D(D)  S D=D1,S=S+1 I $E(IOST)="C",S+4>IOSL S DIR(0)="E" D ^DIR Q:'Y  S S=0
        !            39:        S:D="" (D,D1)=-1 D 0^DIWW K DIP,Y,DIWF
        !            40:        Q
        !            41: DT     I Y W $E(Y,6,7)," ",$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$E(Y,4,5))_" ",Y\10000+1700 W:Y#1 " @ "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12) Q
        !            42:        W Y Q
        !            43:        ;
        !            44: 5      ;;SPECIFIERS
        !            45:        S DI=+Y G 11^DIU
        !            46:        ;
        !            47: 6      ;;INSTALL/VERIFY FILEGRAM
        !            48:        S DIC(0)="QEAMNIZ",DIC=1.12 D ^DIC K DIC Q:Y<0  Q:'$P(Y(0),U,6)
        !            49:        S DIFGLO="^XMB(3.9,"_$P(Y(0),U,6)_",2,",DIFGG=+Y
        !            50:        D ^DIFG W !,$S($D(DIFGER):"UNSUCCESSFUL INSTALLATION: "_DIFGER,1:"DONE")
        !            51:        S $P(^DIAR(1.12,DIFGG,0),U,2)=$S($D(DIFGER):"u",1:"i") K DIFGER,DIFGG Q