- 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.DOMAIN.EXT")=""
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFED 2894 printed Mar 13, 2025@21:41:12 Page 2
- RMPFED ;KLQ/DDC;SERVER- ROES FILE UPDATES; [ 06/25/98 12:16 PM ]
- +1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**1,13,16**;JUN 16, 1995
- +2 ;;Reference to ^XMB(3.9) supported by DBIA #10113
- +3 if '$DATA(XMZ)
- GOTO END
- if 'XMZ
- GOTO END
- SET X=$$SUBGET^XMGAPI0(XMZ)
- if X=""
- GOTO END
- +4 SET RMPFUN=$PIECE(X,"*",2)
- SET RMPFNUM=$PIECE(X,"*",3)
- SET RMPFMENU=0
- DO ^RMPFUTL
- +5 FOR CT=1:1:4
- SET XQSTXT(CT)=" "
- +6 SET CT=CT+1
- SET XQSTXT(CT)="The following entries in the indicated file"
- +7 SET CT=CT+1
- SET XQSTXT(CT)="have been modified by Update #"_RMPFUN
- +8 SET CT=CT+1
- SET XQSTXT(CT)=" "
- +9 SET CT=CT+1
- SET XQSTXT(CT)="FILE: "_$SELECT($DATA(^RMPF(RMPFNUM,0)):$PIECE(^(0),U,1),1:RMPFNUM)
- +10 SET CT=CT+1
- SET XQSTXT(CT)=" "
- +11 IF RMPFNUM'?1"791"1.NP
- SET ER=4
- DO ERROR
- GOTO QUE
- T1 KILL XS
- FOR ML=1:1:4
- XECUTE XMREC
- if XMER=-1
- QUIT
- SET XS(ML)=XMRG
- +1 IF XMER>-1
- DO PROCESS
- if ER
- DO ERROR
- GOTO T1
- QUE IF $PIECE($HOROLOG,",",2)>86000
- SET VW=($PIECE($HOROLOG,",",1)+1)_",00090"
- +1 IF '$TEST
- SET VW=$PIECE($HOROLOG,",",1)_","_($PIECE($HOROLOG,",",2)+90)
- CONFIRM SET XMSUB="ROES UPDATE CONFIRMATION*"_RMPFUN
- SET XMDUZ=.5
- DO XMZ^XMA2
- if XMZ=""
- QUIT
- +1 SET ^XMB(3.9,XMZ,2,0)="^3.92A^1^1^"_DT
- +2 SET ^XMB(3.9,XMZ,2,1,0)=RMPFUN_U_RMPFSTAP
- +3 SET XMY("S.RMPE-FILE-UPDATE-CONFIRM@DDC.DOMAIN.EXT")=""
- +4 DO ENT1^XMD
- END KILL BE,BF,CT,ER,ET,I,ML,RMPFNUM,RMPFUN,VW,RMPFSTAP
- +1 KILL X,XMDUZ,XMSUB,XMY,XMZ,XS,ZTDESC,ZTDTH,ZTRTN,ZTSAVE
- QUIT
- PROCESS SET (BF,BE,ER)=0
- FOR I=1:1:4
- if '$DATA(XS(I))
- SET ER=1
- if ER
- QUIT
- +1 IF XS(1)?1"S (DIC,DLAYGO)=""^RMPF(791".8NP1",DIC(0)=""MX""".1",DIC(""DR"")="".03///".E
- +2 IF '$TEST
- IF XS(1)?1"S DA(1)=RMI,DLAYGO=791".8NP1",DIC=""^RMPF(791".22ANP1",DIC(0)=""MX"""
- if '$DATA(RMI)
- SET ER=6
- +3 IF '$TEST
- IF XS(1)?1"S DIE=""^RMPF(791".8NP!(XS(1)?1"S DA(1)=RMI,DIE=""^RMPF(791".22ANP)
- +4 IF '$TEST
- SET ER=5
- +5 IF XS(2)'?1"S X=".ANP
- IF XS(2)'?1"S DR=".ANP
- SET ER=7
- +6 IF XS(3)'?1"D ^DIC".E
- IF XS(3)'?1"D ^DIE"
- SET ER=8
- +7 IF XS(4)?1"K DIC,DLAYGO,DD,DO Q:Y=-1".ANP
- +8 IF '$TEST
- IF XS(4)="K DIC,DA,DLAYGO,DD,DO Q:Y=-1 S (RMJ,DA)=+Y"!(XS(4)="K DIE,DA,DR")
- +9 IF '$TEST
- SET ER=9
- +10 if ER
- GOTO PX
- +11 XECUTE XS(1)
- IF $DATA(DIC)
- IF $DATA(DIC(0))
- SET BF=1
- if '$DATA(DA(1))
- SET BE=1
- +12 IF '$TEST
- IF $DATA(DIE)
- +13 IF '$TEST
- SET ER=2
- GOTO PX
- +14 XECUTE XS(2)
- SET ER=$SELECT($DATA(X):0,$DATA(DR):0,1:3)
- if ER
- GOTO PX
- +15 XECUTE XS(3)
- IF BF
- IF Y=-1
- KILL DD,DO
- SET DIC(0)=DIC(0)_"L"
- DO FILE^DICN
- +16 IF BF
- IF BE
- SET CT=CT+1
- SET XQSTXT(CT)="ENTRY: "_$PIECE(Y,U,2)
- +17 XECUTE XS(4)
- +18 IF RMPFNUM=791811!(RMPFNUM=791811.1)
- DO MULTI
- PX QUIT
- MULTI IF RMPFNUM=791811
- IF '$DATA(^RMPF(791811,RMI,101,0))
- SET ^(0)="^791811.0101PA^0^0"
- +1 IF RMPFNUM=791811
- IF '$DATA(^RMPF(791811,RMI,102,0))
- SET ^(0)="^791811.0102PA^0^0"
- +2 IF RMPFNUM=791811.1
- IF '$DATA(^RMPF(791811.1,RMI,101,0))
- SET ^(0)="^791811.1101P^0^0"
- +3 QUIT
- ERROR SET ET=$PIECE($TEXT(ETEXT+ER),";",3)
- +1 SET CT=CT+1
- SET XQSTXT(CT)="ERROR: "_$PIECE($TEXT(ETEXT+ER),";",3)
- +2 FOR I=1:1:4
- SET CT=CT+1
- SET XQSTXT(CT)=" XS("_I_")="_$SELECT($DATA(XS(I)):XS(I),1:"UNDEF")
- +3 QUIT
- +4 ;
- ETEXT ;;
- +1 ;;ARRAY NODE NOT DEFINED
- +2 ;;VARIABLE NEEDED FOR OPERATION NOT DEFINED
- +3 ;;INPUT VARIABLE STRING NOT DEFINED
- +4 ;;GLOBAL CANNOT BE PROCESSED BY THIS SERVER
- +5 ;;INVALID INSTRUCTION SPECIFIED - XS(1)
- +6 ;;PREVIOUS-LEVEL LOOKUP NOT SUCCESSFUL
- +7 ;;INVALID INSTRUCTION SPECIFIED - XS(2)
- +8 ;;INVALID INSTRUCTION SPECIFIED - XS(3)
- +9 ;;INVALID INSTRUCTION SPECIFIED - XS(4)
- +10 ;
- +11 QUIT
