source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFED.m@ 975

Last change on this file since 975 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1RMPFED ;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
13T1 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
15QUE I $P($H,",",2)>86000 S VW=($P($H,",",1)+1)_",00090"
16 E S VW=$P($H,",",1)_","_($P($H,",",2)+90)
17CONFIRM 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
22END 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
24PROCESS 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
43PX Q
44MULTI 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
48ERROR 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 ;
53ETEXT ;;
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
Note: See TracBrowser for help on using the repository browser.