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

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