| 1 | RMPFUTL ;DDC/KAW-REMOTE ORDER/ENTRY UTILITIES; [ 06/16/95 3:06 PM ]
|
|---|
| 2 | ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
|
|---|
| 3 | ;; input: RMPFMENU
|
|---|
| 4 | ;;output: RMPFSYS,RMPFDAT,RMPFSTAN,RMPFSTAP
|
|---|
| 5 | K RMPFDAT,RMPFSYS,RMPFSTAN S Y=DT D DD^%DT S RMPFDAT=Y
|
|---|
| 6 | S X=$O(^RMPF(791813,0)) G P2:'X
|
|---|
| 7 | G P2:'$D(^RMPF(791813,X,RMPFMENU)),P1:$P(^(RMPFMENU),U,5)
|
|---|
| 8 | S RMPFSTAN=X,RMPFSTAP=$S($D(^DIC(4,RMPFSTAN,99)):$P(^(99),U,1),1:"")
|
|---|
| 9 | S:RMPFSTAP'="" RMPFSTAP=RMPFSTAP_" - "
|
|---|
| 10 | S RMPFSTAP=RMPFSTAP_$P(^(0),U,1)
|
|---|
| 11 | S:RMPFSTAP="" RMPFSTAP="UNKNOWN"
|
|---|
| 12 | D PARAM G P2
|
|---|
| 13 | P1 S DIC=791813,DIC(0)="AEQN" D ^DIC K DIC I Y=-1 K RMPFSTAN,RMPFSYS G P2
|
|---|
| 14 | S RMPFSTAN=+Y,RMPFSTAP=$S($D(^DIC(4,RMPFSTAN,99)):$P(^(99),U,1),1:"") S:RMPFSTAP'="" RMPFSTAP=RMPFSTAP_" - " S RMPFSTAP=RMPFSTAP_$P(^(0),U,1) D PARAM
|
|---|
| 15 | P2 I $D(RMPFSTAN),RMPFSTAN,$D(^RMPF(791813,RMPFSTAN,0)),$D(RMPFSYS)
|
|---|
| 16 | E W $C(7),!!,"*** REMOTE ORDER/ENTRY PARAMETERS HAVE NOT BEEN DEFINED ***"
|
|---|
| 17 | K DIC,%X,CT,C,Q,I,%,%Y,X,Y Q
|
|---|
| 18 | PARAM K RMPFSYS Q:'$D(^RMPF(791813,RMPFSTAN,RMPFMENU))
|
|---|
| 19 | S RMPFSYS=^RMPF(791813,RMPFSTAN,RMPFMENU)
|
|---|
| 20 | S RMPFSYS(1)=$G(^RMPF(791813,RMPFSTAN,RMPFMENU+1)) Q
|
|---|
| 21 | PAT ;;input: DFN
|
|---|
| 22 | ;;output: RMPFNAM,RMPFSSN,RMPFDOB
|
|---|
| 23 | Q:'$D(DFN) D DEM^VADPT
|
|---|
| 24 | S RMPFNAM=VADM(1),RMPFSSN=$P(VADM(2),U,2),Y=$P(VADM(3),U,1)
|
|---|
| 25 | D DD^%DT S RMPFDOB=Y,RMPFDOD=$P(VADM(6),U,1)
|
|---|
| 26 | I RMPFDOD S Y=RMPFDOD D DD^%DT S RMPFDOD=Y
|
|---|
| 27 | K VADM,VA,VAERR,Y Q
|
|---|
| 28 | COST ;;input: X
|
|---|
| 29 | ;;output: X
|
|---|
| 30 | Q:'$D(X) S Z1=$P(^RMPF(791810,DA(2),101,DA(1),0),U,1)
|
|---|
| 31 | I 'Z1 K X G COSTE
|
|---|
| 32 | I '$D(^RMPF(791811,Z1,101,"B",X)) K X G COSTE
|
|---|
| 33 | S Z2=$O(^RMPF(791811,Z1,101,"B",X,0)) I 'Z2 K X G COSTE
|
|---|
| 34 | I '$D(^RMPF(791811,Z1,101,Z2,0)) K X G COSTE
|
|---|
| 35 | I '$D(^RMPF(791811,Z1,0)) K X G COSTE
|
|---|
| 36 | S M=$P(^RMPF(791811,Z1,0),U,6)
|
|---|
| 37 | S Z3=$P(^RMPF(791811,Z1,101,Z2,0),U,2)*$S(M:1+(M/100),1:1)
|
|---|
| 38 | S $P(^RMPF(791810,DA(2),101,DA(1),102,DA,0),U,2)=Z3
|
|---|
| 39 | COSTE K Z1,Z2,Z3,M Q
|
|---|
| 40 | COSTKILL S $P(^RMPF(791810,DA(2),101,DA(1),102,DA,0),U,2)="" Q
|
|---|
| 41 | END Q
|
|---|
| 42 | MENU ;; input: None
|
|---|
| 43 | ;;output: RMPFMENU
|
|---|
| 44 | S DIC="^RMPF(791810.5,",DIC(0)="AEMQ"
|
|---|
| 45 | S DIC("A")="Select ROES Menu Name: " D ^DIC G MENUE:Y=-1
|
|---|
| 46 | S RMPFMENU=$P(^RMPF(791810.5,+Y,0),U,2) I RMPFMENU="" K RMPFMENU
|
|---|
| 47 | MENUE K DIC,X,Y,%,%Y,DISYS Q
|
|---|
| 48 | DISABLE ;; input: RMPFMENU
|
|---|
| 49 | ;;output: RMPFL
|
|---|
| 50 | K RMPFL S X=0
|
|---|
| 51 | F I=1:1 S X=$O(^RMPF(791810.3,X)) Q:'X I $D(^(X,0)) S S0=^RMPF(791810.3,X,0),Y=$P(S0,U,1),Z=0 F J=1:1 S Z=$O(^DIC(31,"C",Y,Z)) Q:'Z S RMPFL(Z)=""
|
|---|
| 52 | K X,Y,Z,I,J,S0 Q
|
|---|
| 53 | READ K RMPFOUT,RMPFQUT
|
|---|
| 54 | R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
|---|
| 55 | I Y?1"^".E S (RMPFOUT,Y)="" Q
|
|---|
| 56 | S:Y?1"?".E (RMPFQUT,Y)=""
|
|---|
| 57 | Q
|
|---|
