| 1 | RMPFED ;KLQ/DDC;SERVER- ROES FILE UPDATES; [ 06/25/98 12:16 PM ]
|
|---|
| 2 | ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**1,13,16**;JUN 16, 1995
|
|---|
| 3 | ;;Reference to ^XMB(3.9) supported by DBIA #10113
|
|---|
| 4 | G END:'$D(XMZ),END:'XMZ S X=$$SUBGET^XMGAPI0(XMZ) G END:X=""
|
|---|
| 5 | S RMPFUN=$P(X,"*",2),RMPFNUM=$P(X,"*",3),RMPFMENU=0 D ^RMPFUTL
|
|---|
| 6 | F CT=1:1:4 S XQSTXT(CT)=" "
|
|---|
| 7 | S CT=CT+1,XQSTXT(CT)="The following entries in the indicated file"
|
|---|
| 8 | S CT=CT+1,XQSTXT(CT)="have been modified by Update #"_RMPFUN
|
|---|
| 9 | S CT=CT+1,XQSTXT(CT)=" "
|
|---|
| 10 | S CT=CT+1,XQSTXT(CT)="FILE: "_$S($D(^RMPF(RMPFNUM,0)):$P(^(0),U,1),1:RMPFNUM)
|
|---|
| 11 | S CT=CT+1,XQSTXT(CT)=" "
|
|---|
| 12 | I RMPFNUM'?1"791"1.NP S ER=4 D ERROR G QUE
|
|---|
| 13 | T1 K XS F ML=1:1:4 X XMREC Q:XMER=-1 S XS(ML)=XMRG
|
|---|
| 14 | I XMER>-1 D PROCESS,ERROR:ER G T1
|
|---|
| 15 | QUE I $P($H,",",2)>86000 S VW=($P($H,",",1)+1)_",00090"
|
|---|
| 16 | E S VW=$P($H,",",1)_","_($P($H,",",2)+90)
|
|---|
| 17 | CONFIRM S XMSUB="ROES UPDATE CONFIRMATION*"_RMPFUN,XMDUZ=.5 D XMZ^XMA2 Q:XMZ=""
|
|---|
| 18 | S ^XMB(3.9,XMZ,2,0)="^3.92A^1^1^"_DT
|
|---|
| 19 | S ^XMB(3.9,XMZ,2,1,0)=RMPFUN_U_RMPFSTAP
|
|---|
| 20 | S XMY("S.RMPE-FILE-UPDATE-CONFIRM@DDC.VA.GOV")=""
|
|---|
| 21 | D ENT1^XMD
|
|---|
| 22 | END K BE,BF,CT,ER,ET,I,ML,RMPFNUM,RMPFUN,VW,RMPFSTAP
|
|---|
| 23 | K X,XMDUZ,XMSUB,XMY,XMZ,XS,ZTDESC,ZTDTH,ZTRTN,ZTSAVE Q
|
|---|
| 24 | PROCESS S (BF,BE,ER)=0 F I=1:1:4 S:'$D(XS(I)) ER=1 Q:ER
|
|---|
| 25 | I XS(1)?1"S (DIC,DLAYGO)=""^RMPF(791".8NP1",DIC(0)=""MX""".1",DIC(""DR"")="".03///".E
|
|---|
| 26 | E I XS(1)?1"S DA(1)=RMI,DLAYGO=791".8NP1",DIC=""^RMPF(791".22ANP1",DIC(0)=""MX""" S:'$D(RMI) ER=6
|
|---|
| 27 | E I XS(1)?1"S DIE=""^RMPF(791".8NP!(XS(1)?1"S DA(1)=RMI,DIE=""^RMPF(791".22ANP)
|
|---|
| 28 | E S ER=5
|
|---|
| 29 | I XS(2)'?1"S X=".ANP,XS(2)'?1"S DR=".ANP S ER=7
|
|---|
| 30 | I XS(3)'?1"D ^DIC".E,XS(3)'?1"D ^DIE" S ER=8
|
|---|
| 31 | I XS(4)?1"K DIC,DLAYGO,DD,DO Q:Y=-1".ANP
|
|---|
| 32 | E I XS(4)="K DIC,DA,DLAYGO,DD,DO Q:Y=-1 S (RMJ,DA)=+Y"!(XS(4)="K DIE,DA,DR")
|
|---|
| 33 | E S ER=9
|
|---|
| 34 | G PX:ER
|
|---|
| 35 | X XS(1) I $D(DIC),$D(DIC(0)) S BF=1 S:'$D(DA(1)) BE=1
|
|---|
| 36 | E I $D(DIE)
|
|---|
| 37 | E S ER=2 G PX
|
|---|
| 38 | X XS(2) S ER=$S($D(X):0,$D(DR):0,1:3) G PX:ER
|
|---|
| 39 | X XS(3) I BF,Y=-1 K DD,DO S DIC(0)=DIC(0)_"L" D FILE^DICN
|
|---|
| 40 | I BF,BE S CT=CT+1,XQSTXT(CT)="ENTRY: "_$P(Y,U,2)
|
|---|
| 41 | X XS(4)
|
|---|
| 42 | I RMPFNUM=791811!(RMPFNUM=791811.1) D MULTI
|
|---|
| 43 | PX Q
|
|---|
| 44 | MULTI I RMPFNUM=791811,'$D(^RMPF(791811,RMI,101,0)) S ^(0)="^791811.0101PA^0^0"
|
|---|
| 45 | I RMPFNUM=791811,'$D(^RMPF(791811,RMI,102,0)) S ^(0)="^791811.0102PA^0^0"
|
|---|
| 46 | I RMPFNUM=791811.1,'$D(^RMPF(791811.1,RMI,101,0)) S ^(0)="^791811.1101P^0^0"
|
|---|
| 47 | Q
|
|---|
| 48 | ERROR S ET=$P($T(ETEXT+ER),";",3)
|
|---|
| 49 | S CT=CT+1,XQSTXT(CT)="ERROR: "_$P($T(ETEXT+ER),";",3)
|
|---|
| 50 | F I=1:1:4 S CT=CT+1,XQSTXT(CT)=" XS("_I_")="_$S($D(XS(I)):XS(I),1:"UNDEF")
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | ETEXT ;;
|
|---|
| 54 | ;;ARRAY NODE NOT DEFINED
|
|---|
| 55 | ;;VARIABLE NEEDED FOR OPERATION NOT DEFINED
|
|---|
| 56 | ;;INPUT VARIABLE STRING NOT DEFINED
|
|---|
| 57 | ;;GLOBAL CANNOT BE PROCESSED BY THIS SERVER
|
|---|
| 58 | ;;INVALID INSTRUCTION SPECIFIED - XS(1)
|
|---|
| 59 | ;;PREVIOUS-LEVEL LOOKUP NOT SUCCESSFUL
|
|---|
| 60 | ;;INVALID INSTRUCTION SPECIFIED - XS(2)
|
|---|
| 61 | ;;INVALID INSTRUCTION SPECIFIED - XS(3)
|
|---|
| 62 | ;;INVALID INSTRUCTION SPECIFIED - XS(4)
|
|---|
| 63 | ;
|
|---|
| 64 | Q
|
|---|
