65 lines
2.8 KiB
Mathematica
65 lines
2.8 KiB
Mathematica
RMPFED ;KLQ/DDC;SERVER- ROES FILE UPDATES; [ 06/25/98 12:16 PM ]
|
|
;;2.0;REMOTE ORDER/ENTRY SYSTEM;**1,13,16**;JUN 16, 1995
|
|
;;Reference to ^XMB(3.9) supported by DBIA #10113
|
|
G END:'$D(XMZ),END:'XMZ S X=$$SUBGET^XMGAPI0(XMZ) G END:X=""
|
|
S RMPFUN=$P(X,"*",2),RMPFNUM=$P(X,"*",3),RMPFMENU=0 D ^RMPFUTL
|
|
F CT=1:1:4 S XQSTXT(CT)=" "
|
|
S CT=CT+1,XQSTXT(CT)="The following entries in the indicated file"
|
|
S CT=CT+1,XQSTXT(CT)="have been modified by Update #"_RMPFUN
|
|
S CT=CT+1,XQSTXT(CT)=" "
|
|
S CT=CT+1,XQSTXT(CT)="FILE: "_$S($D(^RMPF(RMPFNUM,0)):$P(^(0),U,1),1:RMPFNUM)
|
|
S CT=CT+1,XQSTXT(CT)=" "
|
|
I RMPFNUM'?1"791"1.NP S ER=4 D ERROR G QUE
|
|
T1 K XS F ML=1:1:4 X XMREC Q:XMER=-1 S XS(ML)=XMRG
|
|
I XMER>-1 D PROCESS,ERROR:ER G T1
|
|
QUE I $P($H,",",2)>86000 S VW=($P($H,",",1)+1)_",00090"
|
|
E S VW=$P($H,",",1)_","_($P($H,",",2)+90)
|
|
CONFIRM S XMSUB="ROES UPDATE CONFIRMATION*"_RMPFUN,XMDUZ=.5 D XMZ^XMA2 Q:XMZ=""
|
|
S ^XMB(3.9,XMZ,2,0)="^3.92A^1^1^"_DT
|
|
S ^XMB(3.9,XMZ,2,1,0)=RMPFUN_U_RMPFSTAP
|
|
S XMY("S.RMPE-FILE-UPDATE-CONFIRM@DDC.VA.GOV")=""
|
|
D ENT1^XMD
|
|
END K BE,BF,CT,ER,ET,I,ML,RMPFNUM,RMPFUN,VW,RMPFSTAP
|
|
K X,XMDUZ,XMSUB,XMY,XMZ,XS,ZTDESC,ZTDTH,ZTRTN,ZTSAVE Q
|
|
PROCESS S (BF,BE,ER)=0 F I=1:1:4 S:'$D(XS(I)) ER=1 Q:ER
|
|
I XS(1)?1"S (DIC,DLAYGO)=""^RMPF(791".8NP1",DIC(0)=""MX""".1",DIC(""DR"")="".03///".E
|
|
E I XS(1)?1"S DA(1)=RMI,DLAYGO=791".8NP1",DIC=""^RMPF(791".22ANP1",DIC(0)=""MX""" S:'$D(RMI) ER=6
|
|
E I XS(1)?1"S DIE=""^RMPF(791".8NP!(XS(1)?1"S DA(1)=RMI,DIE=""^RMPF(791".22ANP)
|
|
E S ER=5
|
|
I XS(2)'?1"S X=".ANP,XS(2)'?1"S DR=".ANP S ER=7
|
|
I XS(3)'?1"D ^DIC".E,XS(3)'?1"D ^DIE" S ER=8
|
|
I XS(4)?1"K DIC,DLAYGO,DD,DO Q:Y=-1".ANP
|
|
E I XS(4)="K DIC,DA,DLAYGO,DD,DO Q:Y=-1 S (RMJ,DA)=+Y"!(XS(4)="K DIE,DA,DR")
|
|
E S ER=9
|
|
G PX:ER
|
|
X XS(1) I $D(DIC),$D(DIC(0)) S BF=1 S:'$D(DA(1)) BE=1
|
|
E I $D(DIE)
|
|
E S ER=2 G PX
|
|
X XS(2) S ER=$S($D(X):0,$D(DR):0,1:3) G PX:ER
|
|
X XS(3) I BF,Y=-1 K DD,DO S DIC(0)=DIC(0)_"L" D FILE^DICN
|
|
I BF,BE S CT=CT+1,XQSTXT(CT)="ENTRY: "_$P(Y,U,2)
|
|
X XS(4)
|
|
I RMPFNUM=791811!(RMPFNUM=791811.1) D MULTI
|
|
PX Q
|
|
MULTI I RMPFNUM=791811,'$D(^RMPF(791811,RMI,101,0)) S ^(0)="^791811.0101PA^0^0"
|
|
I RMPFNUM=791811,'$D(^RMPF(791811,RMI,102,0)) S ^(0)="^791811.0102PA^0^0"
|
|
I RMPFNUM=791811.1,'$D(^RMPF(791811.1,RMI,101,0)) S ^(0)="^791811.1101P^0^0"
|
|
Q
|
|
ERROR S ET=$P($T(ETEXT+ER),";",3)
|
|
S CT=CT+1,XQSTXT(CT)="ERROR: "_$P($T(ETEXT+ER),";",3)
|
|
F I=1:1:4 S CT=CT+1,XQSTXT(CT)=" XS("_I_")="_$S($D(XS(I)):XS(I),1:"UNDEF")
|
|
Q
|
|
;
|
|
ETEXT ;;
|
|
;;ARRAY NODE NOT DEFINED
|
|
;;VARIABLE NEEDED FOR OPERATION NOT DEFINED
|
|
;;INPUT VARIABLE STRING NOT DEFINED
|
|
;;GLOBAL CANNOT BE PROCESSED BY THIS SERVER
|
|
;;INVALID INSTRUCTION SPECIFIED - XS(1)
|
|
;;PREVIOUS-LEVEL LOOKUP NOT SUCCESSFUL
|
|
;;INVALID INSTRUCTION SPECIFIED - XS(2)
|
|
;;INVALID INSTRUCTION SPECIFIED - XS(3)
|
|
;;INVALID INSTRUCTION SPECIFIED - XS(4)
|
|
;
|
|
Q
|