source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR293.m@ 1424

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

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1RMPR293 ;PHX/JLT/HNB -DISPLAY JOB RECORD INFO ;[ 10/04/94 10:15 AM ]
2 ;;3.0;PROSTHETICS;**50**;Feb 09, 1996
3 ;
4 ; ODJ - patch 50 - 7/14/00 - fix display problem which is causing
5 ; remarks not to be displayed
6 ; NOIS CTX-0197-70330
7 ; - patch 50 - 7/18/00 - prevent crash at DISP+8 see NOIS's
8 ; FGH-1099-30059, KAN-0500-40811
9 ;
10DISP(PRDA) ;CALLED FROM TEMPLATE [RMPR 25293] AND RMPRPRT
11 ; VARIABLES REQUIRED: RMPRDA - ENTRY IN FILE 664.1
12 ; PRDA - ENTRY IN FILE 664.1 (COPY PASSED IN)
13 ; RMPR("L") - A LINE OF '-'S
14 Q:$G(PRDA)'>1
15 ;disp is called from RMPR29R, and print template [RMPR 25293]
16 ;iost could be either C- or P-, quit if it is a printer
17 Q:IOST["P-"
18 Q:'$D(^RMPR(664.1,PRDA,0)) ; p50 LAB issue problem not setting 664.1
19 Q:$P(^RMPR(664.1,PRDA,0),U,20) N D0 D GET^RMPR29W(PRDA) Q:'$D(RCK)
20SGL ;DISPLAY JOB SECTION INFO
21 ;EXPECTS ^UTILITY("DIQ1",$J,644.1, ARRAY TO BE SET UP.
22 ;
23 ;p50 - remove PRDA from NEWED vars.
24 N LC,MC,PAGE,SCH,SRC,TLC,TMC,TSH,TYPE
25 ;RMPRBCK is set from RMPRPAT3, display extended screen from
26 ;page 4 of the 2319 record.
27 I IOST["C-",'$D(RMPRBCK) N DIR S DIR(0)="E" D ^DIR
28 S (PAGE,MC,LC,TMC,TLC,TSH)=0 D HDR^RMPR29W(RMPRDA) S RI=$O(RCK(0)),(RJ,RTHD)=0
29ITD ;item display
30 G:($Y+6>IOSL)!(RI'>0) MORE D ITM S RMPRWO=$P(RCK(RI),U,3)
31TCH ;Check technician on work order
32 G:'$D(TECH(RMPRWO))!($O(TECH(RMPRWO,0))'>0) MU
33 S RTCD=$O(TECH(RMPRWO,0))
34 G:($Y+6>IOSL) MORE S RTC=$O(TECH(RMPRWO,RTCD,664.33,0))
35 I RTC D TDSP G TCH
36MU ;display work order
37 G:($Y+3>IOSL) MORE
38 I $D(TMP(RMPRWO,664.22)) S RJ=$O(TMP(RMPRWO,664.22,0)) I RJ D MDSP G MU
39 S SCH=^UTILITY("DIQ1",$J,664.2,RMPRWO,4,"E")
40 I +SCH S:^UTILITY("DIQ1",$J,664.2,RMPRWO,5,"E") SCH=^("E") S TSH=TSH+SCH W !,?37,"SHIPPING CHARGE: ",?70,$J(SCH,10,2)
41EXT ;display work order
42 G:($Y+6>IOSL) MORE S RW=$O(^UTILITY($J,"TEXT",RMPRWO,0))
43 I RW D WDSP G EXT
44 W !,RMPR("L")
45 S RI=$O(RCK(RI)) G ITD
46MORE ;DISPLAY MORE INFO
47 ;
48 ;p50 ensure next page prompt is asked if not all data displayed
49 I IOST["C-",$Y>(IOSL-6) D
50 . W:$Y<(IOSL-5) !!
51 . N DIR S DIR(0)="E" D ^DIR W @IOF
52 . Q
53 G:+RI'>0 EXIT
54 G:'$D(PRDA) EXIT
55 S RMPRWO=$P(RCK(RI),U,3)
56 I $D(^UTILITY($J,"TEXT",RMPRWO)) S RMPRWZ=1
57 I $D(TECH(RMPRWO)) S RMPRTZ=1
58 I $D(TMP(RMPRWO,664.22)) S RMPRIZ=1
59 I $O(RCK(RI)) S RMPRCZ=1
60 I (+RI>0),$D(RMPRTZ) K RMPRTZ,RMPRIZ,RMPRCZ,RMPRWZ D HDR^RMPR29W(PRDA),ITM G TCH
61 I (+RI>0),$D(RMPRIZ) K RMPRIZ,RMPRCZ,RMPRWZ D HDR^RMPR29W(PRDA),ITM G MU
62 I (+RI>0),$D(RMPRWZ) K RMPRWZ,RMPRCZ D HDR^RMPR29W(PRDA),ITM G EXT
63 I $D(RMPRCZ),+RI K RMPRCZ S RI=$O(RCK(RI)) G:+RI'>0 EXIT D HDR^RMPR29W(PRDA) G ITD
64 G EXIT
65ITM ;DISPLAY ITEM
66 W !,"JOB#:",?6,"("_RI_")",?10,"ITM#: "_$P(RCK(RI),U),?25,$E(^UTILITY("DIQ1",$J,664.16,$P(RCK(RI),U,4),.01),1,25),?54,"DATE MEASURED: "_$$FMTE^XLFDT(^UTILITY("DIQ1",$J,664.2,$P(RCK(RI),U,3),10,"I"),2)
67 W !,"DATE COMPLETED: "_$$FMTE^XLFDT(^UTILITY("DIQ1",$J,664.2,$P(RCK(RI),U,3),8,"I"),2)
68 W ?25,"COMPLETED BY: "_$E(^UTILITY("DIQ1",$J,664.2,$P(RCK(RI),U,3),9,"E"),1,14),?54,"CHECKED BY: "_$E(^UTILITY("DIQ1",$J,664.2,$P(RCK(RI),U,3),11,"E"),1,14),!
69 Q
70AMC ;GET AMIS CODES FROM 660
71 S PZD=$G(^RMPR(661,$P($G(^RMPR(660,+$P($G(RCK(RI)),U,2),0)),U,6),0)) G DA
72ADC(RD0,RD1) ;SEARCH AMIS ITEM
73 K RLAB
74 I '$D(PZD),$D(RD0),$D(RD1) D
75 .S:$P(^RMPR(664.1,RD0,0),U,15)=$G(RMPR("STA")) RLAB=1
76 .S PZD=$G(^RMPR(661,$P($G(^RMPR(664.1,RD0,2,RD1,0)),U),0))
77 .S TYPE=$P(^RMPR(664.1,RD0,2,RD1,0),U,7)
78 .S SRC=$P(^RMPR(664.1,RD0,0),U,11)
79DA ;DISPLAY SINGLE ITEM AMIS
80 ;restoration repair
81 ;new line
82 Q:'$D(SRC)
83 I TYPE="X",SRC="R" D
84 .X $S($D(D0):"W !,?9",1:"W !,?10")
85 .W "ADMIN REPAIR CODE: ",$P($G(^RMPR(663,+$P(PZD,U,4),0)),U)
86 .W:$D(RLAB) ?50,"RESTORATION REPAIR CODE: ",$P($G(^RMPR(663,+$P(PZD,U,8),0)),U)
87 ;ortho repair
88 I TYPE="X",SRC'="R" D
89 .X $S($D(D0):"W !,?9",1:"W !,?10")
90 .W "ADMIN REPAIR CODE: ",$P($G(^RMPR(663,+$P(PZD,U,4),0)),U)
91 .W:$D(RLAB) ?50,"ORTHO REPAIR CODE: ",$P($G(^RMPR(663,+$P(PZD,U,6),0)),U)
92 ;ortho new
93 I TYPE'="X",SRC'="R" D
94 .X $S($D(D0):"W !,?9",1:"W !,?10")
95 .W "ADMIN NEW CODE: ",$P($G(^RMPR(663,+$P(PZD,U,3),0)),U)
96 .W:$D(RLAB) ?50,"ORTHO NEW CODE: ",$P($G(^RMPR(663,+$P(PZD,U,5),0)),U)
97 ;restoration new
98 I TYPE'="X",SRC="R" D
99 .X $S($D(D0):"W !,?9",1:"W !,?10")
100 .W "ADMIN NEW CODE: ",$P($G(^RMPR(663,+$P(PZD,U,3),0)),U)
101 .W:$D(RLAB) ?50,"RESTORATION NEW CODE: ",$P($G(^RMPR(663,+$P(PZD,U,7),0)),U)
102 K PZD,RLAB,RD0,RD1 Q
103MDSP ;DISPLAY MATERIALS
104 W !,"MATERIALS:",?15,$E(TMP(RMPRWO,664.22,RJ,.01),1,20)
105 W ?37,TMP(RMPRWO,664.22,RJ,1),?42,TMP(RMPRWO,664.22,RJ,6)
106 W ?47,$E(TMP(RMPRWO,664.22,RJ,3),1),?53,$J(TMP(RMPRWO,664.22,RJ,2),7,2)
107 S MC=TMP(RMPRWO,664.22,RJ,1)*TMP(RMPRWO,664.22,RJ,2),TMC=TMC+MC
108 W ?64,"TOTAL:",?69,$J(MC,10,2)
109 I $G(TMP(RMPRWO,664.22,RJ,10))'="" D
110 .S RVA=$O(^RMPR(660,"E",TMP(RMPRWO,664.22,RJ,10),0))
111 .W !,?15,TMP(RMPRWO,664.22,RJ,10)
112 .I $D(^RMPR(660,+RVA,0)) S RDEL=$P(^(0),U,12) W ?37,"DATE DELIVERED: ",?53,$$FMTE^XLFDT(RDEL,2)
113 K TMP(RMPRWO,664.22,RJ)
114 Q
115TDSP ;DISPLAY TECHNICIAN
116 W !,"DATE:",?6,$$FMTE^XLFDT(RTCD,2)
117 W ?15,$E(TECH(RMPRWO,RTCD,664.33,RTC,.01,"E"),1,20),?37,"HRS"
118 W ?42,TECH(RMPRWO,RTCD,664.33,RTC,1,"E"),?47,"RATE:"
119 S RTR=TECH(RMPRWO,RTCD,664.33,RTC,2,"I") W ?53,$J(RTR,7,2)
120 S LC=TECH(RMPRWO,RTCD,664.33,RTC,1,"I")*RTR,TLC=TLC+LC
121 W ?64,"TOTAL:",$J(LC,10,2) K TECH(RMPRWO,RTCD,664.33,RTC) S RTHD=RTCD
122 Q
123WDSP ;DISPLAY REMARKS FIELD
124 W !,^UTILITY($J,"TEXT",RMPRWO,RW)
125 K ^UTILITY($J,"TEXT",RMPRWO,RW),RR Q
126EXIT ;common exit point
127 W !,?45,"TOTAL LABOR COST: ",?69,$J(TLC,10,2)
128 W !,?45,"TOTAL MATERIAL COST:",?69,$J(TMC+TSH,10,2)
129 W !,?45,"TOTAL COST",?69,$J(TLC+TMC,10,2)
130 ;D MORE ;I IOST["C-" W !,"Press 'RETURN' to continue:" ;R !,"Press RETURN to Continue:",RX:DTIME W "KEY PRESSED !" I '$T Q
131 N DIR S DIR(0)="E" D ^DIR W @IOF
132 K TECH,TMP,RDEL,RCK,RI,RJ,RP,RTC,RTCD,RTHD,RTR,RVA,RW,RX
133 I $G(RMPRBAC1)>0 Q
134 I $G(RMPRDA)'>0 K RMPRBAC1,RMPRDA,RMPRWO Q
135 K RMPRWO Q
Note: See TracBrowser for help on using the repository browser.