source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRN63.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1RMPRN63 ;HINES/HNC -NPPD CALCULATIONS - CONT; 02/14/98
2 ;;3.0;PROSTHETICS;**31,34,35,36,39,46,48,50,51,70,72**;Feb 09, 1996
3 ;
4 ; ODJ - patch 50 - store number of each type of NPPD line
5 ;DBIA # 801 - for this routine, the agreement covers the field
6 ; #.05 Short Description.
7 ;
8 ;DBIA #10060 - Fileman read of file #200
9 ;
10CODE N I,NULINE
11 ;
12 ; read in NPPD new
13 F I=1:1 S NULINE=$P($T(DES+I^RMPRN62),";;",2) Q:$E(NULINE)="R" D
14 . S $P(^TMP($J,"N",STN,$P(NULINE,";",1)),U,15)=$P(NULINE,";",2)
15 . S ^TMP($J,"RMPRCODE",$P(NULINE,";",1))=$P(NULINE,";",2)
16 . Q
17 S $P(^TMP($J,"RMPRCODE"),U,1)=I-1 ;store number of new lines
18 ;
19 ; read in NPPD repair
20 F I=0:1 S NULINE=$P($T(REP+I^RMPRN62),";;",2) Q:$E(NULINE)'="R" D
21 . S $P(^TMP($J,"R",STN,$P(NULINE,";",1)),U,15)=$P(NULINE,";",2)
22 . S ^TMP($J,"RMPRCODE",$P(NULINE,";",1))=$P(NULINE,";",2)
23 . Q
24 S $P(^TMP($J,"RMPRCODE"),U,2)=I ;store number of repair lines
25 Q
26HOLD ;hold screen
27 K DIR I IOST["C-" W !! S DIR(0)="E" D ^DIR S:+Y'>0 FL=1
28 Q
29HDR W @IOF S PAGE=PAGE+1
30 W !,LN,!,CODE
31 W ?10,^TMP($J,"RMPRCODE",CODE)
32 W ?35,DATE(3)," - ",DATE(4)
33 W ?70,"Page: ",PAGE
34 W !,LN,!
35 I IOM<119 W "NAME",?10,"SSN",?16,"HCPCS",?22,"QTY",?27,"TYPE",?32,"COST",?42,"DATE",?48,"ITEM",?62,"HCPCS DES",?76,"WHO",!,LN
36 I IOM>119 W "NAME",?10,"SSN",?16,"HCPCS",?22,"QTY",?27,"TYPE",?32,"COST",?42,"DATE",?48,"ITEM",?80,"HCPCS DES",?112,"WHO",?117,"#",!,LN
37 Q
38DESP ;desplay detail records
39 S FL=""
40 S CODE=""
41 F S CODE=$O(^TMP($J,CODE)) Q:CODE="N" G:FL=1 EXIT D
42 .D HDR
43 .S RDX=0
44 .F S RDX=$O(^TMP($J,CODE,RDX)) D:RDX'>0 HOLD Q:RDX'>0 Q:FL=1 D
45 ..S DFN=$P(^RMPR(660,RDX,0),U,2) Q:DFN=""
46 ..D DEM^VADPT
47 ..I $Y+6>IOSL,IOST["C-" K DIR W !! S DIR(0)="E" D ^DIR S:+Y'>0 FL=1 Q:+Y'>0 D HDR
48 ..I $Y+6>IOSL,IOST'["C-" D HDR
49 ..W !,$E($P(VADM(1),",",1),1,9)
50 ..W ?10,$P(VADM(2),"-",3)
51 ..S TYPE=$P(^RMPR(660,RDX,0),U,4)
52 ..S QTY=$P(^RMPR(660,RDX,0),U,7)
53 ..S HCPCS=$P(^RMPR(661.1,$P(^RMPR(660,RDX,1),U,4),0),U,1)
54 ..S HCPCSD=$P(^RMPR(661.1,$P(^RMPR(660,RDX,1),U,4),0),U,2)
55 ..S WHO=$$GET1^DIQ(200,$P($G(^RMPR(660,RDX,0)),U,27),1)
56 ..I $G(RDX) S OPEN=$P(^RMPR(660,RDX,0),U,12)
57 ..I OPEN="" S OPEN="*"
58 ..E S OPEN=" "
59 ..S COST=^TMP($J,CODE,RDX)
60 ..S SOURCE=$P(^RMPR(660,RDX,0),U,14)
61 ..S DATE=$P(^RMPR(660,RDX,0),U,1),DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)
62 ..S ITEM=$P(^PRC(441,$P(^RMPR(661,$P(^RMPR(660,RDX,0),U,6),0),U,1),0),U,2)
63 ..I IOM<119 W ?16,HCPCS,?22,QTY,?27,TYPE,?29,SOURCE,?32,OPEN,COST,?42,DATE,?48,$E(ITEM,1,11),?61,"|",?62,$E(HCPCSD,1,12),?76,WHO
64 ..I IOM>118 W ?16,HCPCS,?22,QTY,?27,TYPE,?29,SOURCE,?32,OPEN,COST,?42,DATE,?48,$E(ITEM,1,29),?79,"|",?80,$E(HCPCSD,1,30),?112,WHO,?117,RDX
65 Q
66DESPR ;repair dispaly
67 ;
68 S CODE="R1"
69 F S CODE=$O(^TMP($J,CODE)) Q:CODE["RMPR" Q:FL=1 D
70 .D HDR
71 .S RDX=0
72 .F S RDX=$O(^TMP($J,CODE,RDX)) D:RDX'>0 HOLD Q:RDX'>0 Q:FL=1 D
73 ..S DFN=$P(^RMPR(660,RDX,0),U,2) Q:DFN=""
74 ..D DEM^VADPT
75 ..Q:FL=1
76 ..I $Y+6>IOSL,IOST["C-" K DIR W !! S DIR(0)="E" D ^DIR S:+Y'>0 FL=1 Q:+Y'>0 D HDR
77 ..I $Y+6>IOSL,IOST'["C-" D HDR
78 ..W !,$E($P(VADM(1),",",1),1,9)
79 ..W ?10,$P(VADM(2),"-",3)
80 ..S TYPE=$P(^RMPR(660,RDX,0),U,4)
81 ..S QTY=$P(^RMPR(660,RDX,0),U,7)
82 ..S SOURCE=$P(^RMPR(660,RDX,0),U,14)
83 ..I $P(^RMPR(660,RDX,0),U,17)'="" S HCPCS="#SHIP",ITEM="SHIPPING"
84 ..I $P(^RMPR(660,RDX,0),U,26)'="" S HCPCS="#PICK",ITEM="PICKUP/DEL"
85 ..S:$G(HCPCS)'["#" HCPCS=$P(^RMPR(661.1,$P(^RMPR(660,RDX,1),U,4),0),U,1)
86 ..S:$G(HCPCS)'["#" HCPCSD=$P(^RMPR(661.1,$P(^RMPR(660,RDX,1),U,4),0),U,2)
87 ..I $G(HCPCS)["#S" S HCPCSD="SHIPPING"
88 ..I $G(HCPCS)["#P" S HCPCSD="PICKUP/DEL",SOURCE="C"
89 ..S WHO=$$GET1^DIQ(200,$P($G(^RMPR(660,RDX,0)),U,27),1)
90 ..I $G(RDX) S OPEN=$P(^RMPR(660,RDX,0),U,12)
91 ..I OPEN="" S OPEN="*"
92 ..E S OPEN=" "
93 ..S COST=^TMP($J,CODE,RDX)
94 ..;S SOURCE=$P(^RMPR(660,RDX,0),U,14)
95 ..S DATE=$P(^RMPR(660,RDX,0),U,1),DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)
96 ..S:$G(HCPCS)'["#" ITEM=$P(^PRC(441,$P(^RMPR(661,$P(^RMPR(660,RDX,0),U,6),0),U,1),0),U,2)
97 ..I IOM<119 W ?16,HCPCS,?22,QTY,?27,TYPE,?29,SOURCE,?32,OPEN,COST,?42,DATE,?48,$E(ITEM,1,12),?62,$E(HCPCSD,1,12),?76,WHO
98 ..I IOM>118 W ?16,HCPCS,?22,QTY,?27,TYPE,?29,SOURCE,?32,OPEN,COST,?42,DATE,?48,$E(ITEM,1,29),?79,"|",?80,$E(HCPCSD,1,30),?112,WHO,?117,RDX
99 ..K ITEM,HCPCSD,HCPCS
100 Q
101EXIT ;
102 Q
103 ;END
Note: See TracBrowser for help on using the repository browser.