source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPREOPT.m

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

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1RMPREOPT ;HINES-CIOFO/HNC,RVD - Detail Display Associated 10-2319 Transaction ;2-10-00
2 ;;3.0;PROSTHETICS;**45**;Feb 09, 1996
3 ;expect variables from GETPAT^RMPRUTIL
4 ; RMPRSSNE (external form of SSN)
5 ; RMPRNAM (name of patient)
6 ; RMPRDOB
7 ;
8PRINT(DA) ;extrinsic function to display 660 record in detail
9 ;get 2319 transaction
10 ;
11 N DIC,DIQ,DR,RMPRV,RMPRDA,RV
12 S DIC=660,DIQ="R19",DR=".01:96",DIQ(0)="EN"
13 S RMPRDA=DA
14 D EN^DIQ1
15 S DIQ="R19",DR=72,DIQ(0)="I" D EN^DIQ1
16 ;get vendor info
17 S DA=$P(^RMPR(660,RMPRDA,0),U,9)
18 I DA D
19 .S DIC=440,DIQ="RV",DR=".01:6",DIQ(0)="EN"
20 .S (RMPRV,DA)=$P(^RMPR(660,RMPRDA,0),U,9)
21 .D EN^DIQ1
22 ;
23 ;array defined for record in following format:
24 ;R19(filenumber,ien,field,E)=external form of data
25 ;RV(filenumber,ien,field,E)=external form of data
26 ;example:
27 ;R19(660,100,.01,"E")=APR 27, 1995
28 ;R19(660,100,.02,"E")=FUDGE,CHOCOLATE
29 ;RV(440,131,.01,"E")=ORTHOTIC LAB
30 ;
31 D HDR
32 W !,"TYPE OF FORM: ",$G(R19(660,RMPRDA,11,"E"))
33 W ?25,"INITIATOR: ",$G(R19(660,RMPRDA,27,"E"))
34 W ?55,"DATE: ",$G(R19(660,RMPRDA,1,"E"))
35 W !,"DELIVER TO: ",$G(R19(660,RMPRDA,25,"E"))
36 W !,"TYPE TRANS: ",$G(R19(660,RMPRDA,2,"E"))
37 W ?30,"QTY: ",$G(R19(660,RMPRDA,5,"E"))
38 W:$G(R19(660,RMPRDA,29,"E")) ?40,"INVENTORY POINT: ",R19(660,RMPRDA,29,"E")
39 W ?40,"SOURCE: ",$G(R19(660,RMPRDA,12,"E"))
40 ;vendor tracking number
41 I $G(R19(660,RMPRDA,11,"E"))="VISA" D
42 .W !,"VENDOR TRACKING: ",$G(R19(660,RMPRDA,4.2,"E"))
43 .W ?38,"BANK AUTHORIZATION: ",$G(R19(660,RMPRDA,4.3,"E"))
44 W !,"VENDOR: ",?15,$G(R19(660,RMPRDA,7,"E"))
45 I $D(RV) D
46 .W !,"VENDOR PHONE: ",?15,$G(RV(440,RMPRV,5,"E"))
47 .W !?15,$G(RV(440,RMPRV,1,"E"))
48 .W !?15,$G(RV(440,RMPRV,4.2,"E")),","
49 .W ?$X+3,$G(RV(440,RMPRV,4.4,"E")),?$X+5,$G(RV(440,RMPRV,4.6,"E"))
50 W !,"DELIVERY DATE: "
51 I $D(R19(660,RMPRDA,10,"E")) W R19(660,RMPRDA,10,"E")
52 W !
53 ;I '$P(IT(AN),U,3) D
54 ;.W "TOTAL COST: "
55 ;.I $G(R19(660,RMPRDA,14,"E"))'="" W "$"_$J(R19(660,RMPRDA,14,"E"),2)
56 ;.I $G(R19(660,RMPRDA,14,"E"))="" W $S($G(R19(660,RMPRDA,6,"E"))'="":"$"_$J(R19(660,RMPRDA,6,"E"),2),$G(R19(660,RMPRDA,48,"E"))'="":"$"_$J(R19(660,RMPRDA,48,"E"),2),1:"")
57 W ?30,"OBL: ",$G(R19(660,RMPRDA,23,"E"))
58 ;
59 ;lab data
60 I $D(^RMPR(660,RMPRDA,"LB")) D
61 .N DIC,DIQ,DR,L19,DA
62 .S (DA,RMPRLA)=$P(^RMPR(660,RMPRDA,"LB"),U,10)
63 .Q:DA=""
64 .S DIC=664.1,DIQ="L19",DR="15",DIQ(0)="E"
65 .D EN^DIQ1
66 .W !,"WORK ORDER: ",$G(R19(660,RMPRDA,71,"E"))
67 .W ?40,"RECEIVING STATION: ",$G(R19(660,RMPRDA,70,"E"))
68 .W !,"TECHNICIAN: ",$G(L19(664.1,RMPRLA,15,"E"))
69 .W !,"TOTAL LABOR HOURS: ",$G(R19(660,RMPRDA,45,"E"))
70 .W ?40,"TOTAL LABOR COST: ",$G(R19(660,RMPRDA,46,"E"))
71 .W !,"TOTAL MATERIAL COST: ",$G(R19(660,RMPRDA,47,"E"))
72 .W ?40,"TOTAL LAB COST: ",$G(R19(660,RMPRDA,48,"E"))
73 .W !,"COMPLETION DATE: ",$G(R19(660,RMPRDA,50,"E"))
74 .W ?40,"LAB REMARKS: ",$G(R19(660,RMPRDA,51,"E"))
75 W !,"REMARKS: ",?15,$G(R19(660,RMPRDA,16,"E"))
76 I $G(R19(660,RMPRDA,17.5,"E")) W ?40,"RETURN STATUS: ",R19(660,RMPRDA,17.5,"E")
77 ;
78 ;historical data
79 I $G(R19(660,RMPRDA,15,"E"))["*" D
80 .;include records that have been merged
81 .W !!,"HISTORICAL DATA",!
82 .Q:'$D(R19(660,RMPRDA,89))
83 .W !,?15,"ITEM: ",$G(R19(660,RMPRDA,89,"E"))
84 .W !,?15,"STATION: ",$G(R19(660,RMPRDA,90,"E"))
85 .W !,?15,"VENDOR: ",$G(R19(660,RMPRDA,91,"E"))," PHONE: ",$G(R19(660,RMPRDA,92,"E"))
86 .W !,?23,$G(R19(660,RMPRDA,93,"E")),!,?23,$G(R19(660,RMPRDA,94,"E"))
87 .W " ",$G(R19(660,RMPRDA,95,"E"))," ",$G(R19(660,RMPRDA,96,"E"))
88 ;put in lab display here fields 45,46,47,48 and 51
89 ;lab amis
90 I $G(R19(660,RMPRDA,73,"E")) D
91 .W ?40,"ORTHOTICS LAB CODE: "
92 .W $S($D(R19(660,RMPRDA,74,"E")):R19(660,RMPRDA,74,"E"),$D(R19(660,RMPRDA,75,"E")):R19(660,RMPRDA,75,"E"),1:"")
93 .W ?40,"RESTORATIONS LAB CODE: "
94 .W $S($D(R19(660,RMPRDA,76,"E")):R19(660,RMPRDA,76,"E"),$D(R19(660,RMPRDA,77,"E")):R19(660,RMPRDA,77,"E"),1:"")
95 ;purchasing and issue from stock amis
96 W !,"DISABILITY SERVED: ",$G(R19(660,RMPRDA,62,"E"))
97 ;appliance/item information
98 W !,"APPLIANCE: ",$G(R19(660,RMPRDA,4,"E"))
99 W !,"PSAS HCPCS: ",$G(R19(660,RMPRDA,4.5,"E"))
100 I $P($G(^RMPR(660,RMPRDA,1)),U,4) W ?22,$P($G(^RMPR(661.1,$P(^RMPR(660,RMPRDA,1),U,4),0)),U,2)
101 W !,"DESCRIPTION: ",$G(R19(660,RMPRDA,24,"E"))
102 W !,"EXTENDED DESCRIPTION: ",!
103 I $D(R19(660,RMPRDA,28)) D
104 .N R28
105 .;command part of new standards
106 .MERGE R28=R19(660,RMPRDA,28)
107 .D EN^DDIOL(.R28)
108 ;NPPD key items consolidated, example L5300 limb order
109 ;I $P(IT(AN),U,3) W !!,"*** Return For DETAIL REPORT ***" N DIR S DIR(0)="E" D ^DIR Q:$D(DUOUT) W @IOF D HDR,^RMPRPAT7
110 ;display work order if it is a 2529-3 form
111 ;must pass ien to file 664.1 NOT 664.2
112 I $G(R19(660,RMPRDA,72,"I"))'="" D K R19,RV W @IOF Q
113 .S DIR(0)="E" D ^DIR ;Q:$D(DTOUT)!$D(DUOUT)
114 .S RMPRBCK=RMPRDA
115 .N DIC
116 .S RMPRDA=R19(660,RMPRBCK,72,"I")
117 .D DISP^RMPR293(RMPRDA)
118 .S RMPRDA=RMPRBCK K RMPRBCK
119 ;return from work order
120 G EXIT
121 ;
122HDR ;display heading
123 W @IOF,RMPRNAM,?30," SSN: "
124 W $E(RMPRSSN,1,3)_"-"_$E(RMPRSSN,4,5)_"-"_$E(RMPRSSN,6,10),?50
125 W $G(R19(660,RMPRDA,8,"E")),?70,"DOB: "
126 W $S(RMPRDOB:$E(RMPRDOB,4,5)_"-"_$E(RMPRDOB,6,7)_"-"_(1700+$E(RMPRDOB,1,3)),1:"Unknown")
127 W !?20,"APPLIANCE/REPAIR LINE ITEM DETAIL ",?70,!
128 Q
129EXIT ;common exit point
130 I $Y>(IOSL-4) F W ! Q:$Y>(IOSL-3)
131 N DIR S DIR(0)="E" D ^DIR
132 ;duout,dtout is evaluated in dis+1^rmprpat2
133 ;back out through that point to clean up
134 K R19,RV W @IOF
135 Q
136 ;end
Note: See TracBrowser for help on using the repository browser.