| 1 | DIFGO ;SFISC/XAK-FILEGRAM OPTIONS ;5:13 AM 7 Jun 2000
|
|---|
| 2 | ;;22.0;VA FileMan;**47**;Mar 30, 1999;
|
|---|
| 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:'$D(Y) Y=0 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 99^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
|
|---|
