| [613] | 1 | RMPFQP1 ;DDC/KAW-PRINT VA FORM 10-2477a [ 06/16/95 3:06 PM ]
|
|---|
| 2 | ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
|
|---|
| 3 | ; input: RMPFSTAN
|
|---|
| 4 | ;output: RMPFR,RMPFS,RMPFRSTA
|
|---|
| 5 | ISS S X=RMPFSTAN I X,$D(^DIC(4,X,0)) S ST=X,TY="S" D STA
|
|---|
| 6 | S RMPFRSTA=""
|
|---|
| 7 | REG S X=$S($D(^RMPF(791813,RMPFSTAN,2)):$P(^(2),U,1),1:"") I X,$D(^DIC(4,X,0)) S RMPFRSTA=$S($D(^DIC(4,X,99)):$P(^(99),U,1),1:""),TY="R",ST=X D STA
|
|---|
| 8 | END K RS,R,TY,ST,I,X,Y Q
|
|---|
| 9 | STA ;; input: ST,TY
|
|---|
| 10 | ;;output: RMPFR or RMPFS
|
|---|
| 11 | S CT=1 K @("RMPF"_TY) S S0=^DIC(4,ST,0)
|
|---|
| 12 | S S="",X=$P(S0,U,2) I X,$D(^DIC(5,X,0)) S S=$P(^(0),U,2)
|
|---|
| 13 | S RS="" I $D(^RMPF(791813,RMPFSTAN,2)) S R=$P(^(2),U,2),RS=$S(R'="":"("_R_")",1:"")
|
|---|
| 14 | S @("RMPF"_TY_"(1)")=$S($P(S0,U,4)'="":$P(S0,U,4),1:"VA MEDICAL CENTER")_" "_RS,S1=$S($D(^DIC(4,ST,1)):^(1),1:"")
|
|---|
| 15 | F I=1:1:2 S X=$P(S1,U,I) I X'="" S CT=CT+1,@("RMPF"_TY_"("_CT_")")=X
|
|---|
| 16 | S C=$P(S1,U,3),Z=$P(S1,U,4),CT=CT+1
|
|---|
| 17 | S @("RMPF"_TY_"("_CT_")")=$E(C,1,21)_", "_S_" "_Z
|
|---|
| 18 | K C,CT,Z,S,X,S0,S1,I,Z Q
|
|---|
| 19 | MOD D ARRAY^RMPFDT2 S RMPFY=0
|
|---|
| 20 | D1 S RMPFY=$O(RMPFO(RMPFY)) G END1:RMPFY="" G D1:'$D(^RMPF(791810,RMPFX,101,RMPFY,0)) S S1=^(0),RMPFIT=$P(S1,U,1)
|
|---|
| 21 | G D1:'RMPFIT,D1:'$D(^RMPF(791811,RMPFIT,0)) S S2=^(0),RMPFITP=$P(S2,U,1),RMPFMAK=$P(S2,U,2)
|
|---|
| 22 | I RMPFITP="NON-CONTRACT",$D(^RMPF(791810,RMPFX,101,RMPFY,2)) S RMPFITP=$P(^(2),U,2),RMPFMAK=$P(^(2),U,1)
|
|---|
| 23 | S RMPFNSN=$P($P(S2,U,5),"-",3,4)
|
|---|
| 24 | S RMPFSN=$P(S1,U,5),RMPFBAT=$P(S1,U,2) I RMPFBAT,$D(^RMPF(791811.3,RMPFBAT,0)) S RMPFBAT=$P(^(0),U,1)
|
|---|
| 25 | S RMPFBAT2="" I $D(^RMPF(791810,RMPFX,101,RMPFY,2)) S RMPFBAT2=$P(^(2),U,3) I RMPFBAT2,$D(^RMPF(791811.3,RMPFBAT2,0)) S RMPFBAT2=$P(^(0),U,1)
|
|---|
| 26 | S RMPFIDP="",Y=$P(S1,U,8)
|
|---|
| 27 | I Y D DD^%DT S RMPFIDP=Y
|
|---|
| 28 | S RMPFREP=$S($D(^RMPF(791810,RMPFX,11)):$P(^(11),U,3),1:"")
|
|---|
| 29 | MODEL W !,"6515-01-",RMPFNSN
|
|---|
| 30 | W ?16,"|",?17,$E(RMPFMAK,1,10)
|
|---|
| 31 | W ?27,"|",?28,$E(RMPFITP,1,16)
|
|---|
| 32 | W ?44,"|",?46,$E(RMPFSN,1,10)
|
|---|
| 33 | W ?57,"|",?59,$E(RMPFBAT,1,7)
|
|---|
| 34 | W ?67,"|" S (X,CT)=0
|
|---|
| 35 | F I=1:1 S X=$O(^RMPF(791810,RMPFX,101,RMPFY,101,X)) Q:'X D
|
|---|
| 36 | .Q:'$D(^RMPF(791810,RMPFX,101,RMPFY,101,X,0)) S SN=$P(^(0),U,1)
|
|---|
| 37 | .I 'CT W ?69,$E(SN,1,11) S CT=CT+1 Q
|
|---|
| 38 | .W !,?16,"|",?27,"|",?44,"|",?57,"|"
|
|---|
| 39 | .I $D(RMPFBAT2),RMPFBAT2'="" W ?59,$E(RMPFBAT2,1,7) K RMPFBAT2
|
|---|
| 40 | .W ?67,"|",?69,$E(SN,1,11)
|
|---|
| 41 | .Q
|
|---|
| 42 | I $D(RMPFBAT2),RMPFBAT2'="" W !?16,"|",?27,"|",?44,"|",?57,"|",?59,$E(RMPFBAT2,1,7),?67,"|"
|
|---|
| 43 | D LINE^RMPFQP3
|
|---|
| 44 | G D1
|
|---|
| 45 | END1 K RMPFY,RMPFIT,RMPFITP,RMPFMAK,RMPFNSN,RMPFSN,RMPFBAT
|
|---|
| 46 | K RMPFIDP,RMPFRSN,CT,SN,S1,I,S2,X Q
|
|---|
