source: FOIAVistA/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFDT2.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1RMPFDT2 ;DDC/KAW-DISPLAY MODELS; [ 03/12/98 7:46 AM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**10**;JUN 16, 1995
3 ;;input: RMPFX,RMPFHAT,RMPFTYP
4 ;;output: RMPFMD,CX,RMPFO
5 I $D(RMPFX),RMPFX
6 E Q
7 I '$O(^RMPF(791810,RMPFX,101,0)) D HEAD G END
8 D ARRAY
9 S (RMPFY,CX,RMPFTOT)=0 K RMPFMD
10D1 S RMPFY=$O(RMPFO(RMPFY)) G TOT:RMPFY="" D SHOW G D1
11SHOW Q:'$D(^RMPF(791810,RMPFX,101,RMPFY,0)) S S1=^(0),S4=$G(^(3)),RMPFIT=$P(S1,U,1),CT=0
12 Q:'RMPFIT Q:'$D(^RMPF(791811,RMPFIT,0)) S S2=^(0)
13 S RMPFTT=$P(S4,U,1),RMPFDIS=$P(S4,U,2)
14 I $L(RMPFDIS) S RMPFDIS=$P($G(^RMPR(662,RMPFDIS,0)),U,1)
15 S RMPFDSN=$P(S4,U,3),X=$P(S4,U,4),(RMPFPCT,RMPFPSC)=""
16 I X S RMPFPCT=$S(X=1:"SC/OP",X=2:"SC/IP",X=3:"NSC/IP",X=4:"NSC/OP",1:"")
17 S X=$P(S4,U,5) I X S RMPFPSC=$S(X=1:"Spec",X=2:"A&A",X=3:"PHC",1:"")
18 S CX=CX+1 K RMPFN,RMPFC
19 S RMPFITP=$P(S2,U,1),RMPFMAK=$P(S2,U,2)
20 S RMPFCOST=$J($P(S1,U,14),0,2),RMPFLR=$P(S1,U,4)
21 S RMPFRACT=$P(S1,U,9),RMPFRACT=$S(RMPFRACT="D":"DEFECTIVE",RMPFRACT="R":"REDUCE STOCK",1:"")
22 S RMPFACQD="",Y=$P(S1,U,3) I Y S RMPFACQD=$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_($E(Y,1,3)+1700)
23 S X=$P(S1,U,8),RMPFISDP="" I X S RMPFISDP=$E(X,4,5)_"-"_$E(X,6,7)_"-"_($E(X,1,3)+1700)
24 S RMPFSN=$P(S1,U,5),RMPFBAT=$P(S1,U,2),RMPFLIS=$P(S1,U,18)
25 I RMPFLIS,$D(^RMPF(791810.2,RMPFLIS,0)) S RMPFLIS=$P(^(0),U,4)
26 S RMPFTOI=$P(S1,U,7),RMPFTOI=$S(RMPFTOI="T":"TEMPORARY",RMPFTOI="P":"PERMANENT",1:""),(RMPFQTY,QT)=$P(S1,U,6) S:'QT QT=1
27 S RMPFRED="",Y=$P(S1,U,13) I Y?7N S RMPFRED=$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_($E(Y,1,3)+1700)
28 S RMPFOB=$P(S1,U,11),RMPFTOL=$P(S1,U,10)
29 S RMPFISRE=$P(S1,U,12),RMPFISRE=$S(RMPFISRE="P":"PERMANENT ISSUE",RMPFISRE="R":"RECOVERY",RMPFISRE="T":"TEMPORARY ISSUE",RMPFISRE="S":"STATION LOANER",1:"")
30 S S3=$G(^RMPF(791810,RMPFX,101,RMPFY,2))
31 I RMPFIT=1 S RMPFMAK=$P(S3,U,1),RMPFITP=$P(S3,U,2)
32 I RMPFBAT,$D(^RMPF(791811.3,RMPFBAT,0)) S RMPFBAT=$P(^(0),U,1)
33 S RMPFBAT2=$P(S3,U,3) I RMPFBAT2,$D(^RMPF(791811.3,RMPFBAT2,0)) S RMPFBAT2=$P(^(0),U,1)
34 S RMPFPG=$P(S3,U,4) I RMPFPG,$D(^RMPF(791811.1,RMPFPG,0)) S RMPFPG=$P(^(0),U,1)
35 S RMPFMD(CX)=RMPFY
36 S X=0 F I=1:1 S X=$O(^RMPF(791810,RMPFX,101,RMPFY,101,X)) Q:'X I $D(^(X,0)),$P(^(0),U)'="" S RMPFN(I)=$P(^(0),U,1)
37 S S9=$G(^RMPF(791810,RMPFX,101,RMPFY,90)),RMPFRDC=$P(S9,U,6)
38 I RMPFRDC S RMPFRDC=$E(RMPFRDC,4,5)_"-"_$E(RMPFRDC,6,7)_"-"_($E(RMPFRDC,1,3)+1700)
39 S RMPFCUR=$P(S9,U,5),RMPFCERU=$P(S9,U,8),RMPFCERD=$P(S9,U,9)
40 I $P(S9,U,10) S RMPFCERU=$P(S9,U,10),RMPFCERD=$P(S9,U,11)
41 I RMPFCERU,$D(^VA(200,RMPFCERU,0)) S RMPFCERU=$P(^(0),U,1)
42 I RMPFCERD S RMPFCERD=$E(RMPFCERD,4,5)_"-"_$E(RMPFCERD,6,7)_"-"_($E(RMPFCERD,1,3)+1700)
43 D ARRAY2
44 S:RMPFHAT'="X" RMPFTOT=RMPFTOT+(RMPFCOST*QT)
45 I IOST?1"C-".E,$Y>21 D CONT G END:$D(RMPFOUT) W @IOF,!,"cont.",!
46 D @("PRT"_RMPFHAT_U_"RMPFDT3") Q
47TOT I $P(^RMPF(791810.1,RMPFTYP,0),U,6) S RMPFTOT=$J(RMPFTOT,0,2) W !?6,"Total Price: ","$"_RMPFTOT
48 I RMPFHAT="C" S X=$P(^RMPF(791810,RMPFX,0),U,7) I X'="" W:$X>30 ! W ?49,"Purchase Order No.: ",X
49 I $D(CN) S CN=CN+1
50END K RMPFTOT,RMPFIT,RMPFITP,RMPFMAK,RMPFCOST,RMPFLR,RMPFSN,RMPFCOM,RMPFN
51 K RMPFCOMC,RMPFREP,RMPFBAT,RMPFISDP,RMPFY,RMPFOB,CY
52 K RMPFTOL,RMPFC,RMPFACQD,RMPFISRE,RMPFOD,RMPFQTY,RMPFRDC,RMPFCUR,QT
53 K RMPFBAT2,RMPFRED,RMPFRACT,RMPFS,RMPFTOI,RMPFCARE,RMPFCAR
54 K RMPFCERD,RMPFCERU,RMPFDIS,RMPFDSN,RMPFLIS,RMPFPCT,RMPFPG,RMPFPSC,RMPFTT
55 K T,J,CS,CT,S1,S2,S3,S4,S9,I,K,X,Y,CM Q
56 Q
57ARRAY ;; input: RMPFX
58 ;;output: RMPFO
59 S RMPFY=0 K RMPFO
60AR1 S RMPFY=$O(^RMPF(791810,RMPFX,101,RMPFY)) G ARE:'RMPFY
61 G AR1:'$D(^RMPF(791810,RMPFX,101,RMPFY,0)) S S0=^(0)
62 S TY=$P(S0,U,15) S:TY="" TY="O" S RL=$P(S0,U,16)
63 S:RL="" RL=RMPFY
64 S:TY["O"!(TY="C") RMPFO(RMPFY)=$P(S0,U,18)
65 I TY["D" K RMPFO(RL)
66 G AR1
67ARE K RMPFY,S0,TY,RL Q
68ARRAY2 ;; input: RMPFX,RMPFY
69 ;;output: RMPFC
70 K RMPFC S RMPFZ=0
71AR2 S RMPFZ=$O(^RMPF(791810,RMPFX,101,RMPFY,102,RMPFZ)) G AR2E:'RMPFZ
72 S S0=^RMPF(791810,RMPFX,101,RMPFY,102,RMPFZ,0),CM=$P(S0,U,1)
73 S CS=$P(S0,U,2),TY=$P(S0,U,3),RL=$P(S0,U,4)
74 S:TY="" TY="O" S:RL="" RL=RMPFZ
75 S:TY="O"!(TY="A") RMPFC(RMPFZ)=CM_U_CS
76 I TY="D" K RMPFC(RL)
77 G AR2
78AR2E K RMPFZ,S0,TY,RL,CS,CM Q
79READ K RMPFOUT,RMPFQUT
80 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
81 I Y?1"^".E S (RMPFOUT,Y)="" Q
82 S:Y?1"?".E (RMPFQUT,Y)=""
83 Q
84HEAD I $D(RMPFEDIT),$D(CN) W "[",CN,"]" S CN=CN+1
85 W ?6,"Make",?17,"Model",?27,"Price"
86 W !?4,"--------",?14,"-----------",?27,"------"
87 Q
88HEAD1 W @IOF,!!?6,"Make",?17,"Model",?27,"Price",?36,"Component",?47,"Com Cst",?56,"Iss. Dt.",?66,"E",?74,"Repl. SN" D LINE^RMPFDT3 Q
89CONT W !,"Enter <RETURN> to continue or <^> to exit: " D READ
90 Q
Note: See TracBrowser for help on using the repository browser.