90 lines
3.6 KiB
Mathematica
90 lines
3.6 KiB
Mathematica
RMPRN6PL ;HINES/HNC -NPPD CALCULATIONS - SINGLE LINE; 02/14/98
|
|
;;3.0;PROSTHETICS;**32,34,36,51,70,72,133**;Feb 09, 1996;Build 2
|
|
;
|
|
;DBIA # 801 - for this routine, the agreement covers the field
|
|
; #.05 Short Description, file #441.
|
|
;
|
|
;DBIA #10060 - Fileman read of file #200
|
|
Q
|
|
HOLD ;hold screen
|
|
K DIR I IOST["C-" W !! S DIR(0)="E" D ^DIR S:+Y'>0 FL=1
|
|
Q
|
|
HDR W @IOF S PAGE=PAGE+1
|
|
W !,LN,!,CODE
|
|
W ?10,^TMP($J,"RMPRCODE",CODE)
|
|
W ?35,DATE(3)," - ",DATE(4)
|
|
W ?70,"Page: ",PAGE
|
|
W !,LN,!
|
|
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
|
|
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
|
|
Q
|
|
DESP ;desplay detail records
|
|
S FL=""
|
|
;code is user defined
|
|
;F S CODE=$O(^TMP($J,CODE)) Q:CODE="N" G:FL=1 EXIT D
|
|
D HDR
|
|
S RDX=0
|
|
F S RDX=$O(^TMP($J,CODE,RDX)) D:RDX'>0 HOLD Q:RDX'>0 Q:FL=1 D
|
|
.S DFN=$P(^RMPR(660,RDX,0),U,2) Q:DFN=""
|
|
.D DEM^VADPT
|
|
.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
|
|
.I $Y+6>IOSL,IOST'["C-" D HDR
|
|
.W !,$E($P(VADM(1),",",1),1,9)
|
|
.W ?10,$P(VADM(2),"-",3)
|
|
.S ITEM="",HCPCSD=""
|
|
.S TYPE=$P(^RMPR(660,RDX,0),U,4)
|
|
.S QTY=$P(^RMPR(660,RDX,0),U,7)
|
|
.S HCPCS=$P($G(^RMPR(660,RDX,1)),U,4)
|
|
.I HCPCS=""&($P(^RMPR(660,RDX,0),U,17)'="") S HCPCS=2676,ITEM="SHIPPING",HCPCSD="SHIPPING"
|
|
.I $P(^RMPR(660,RDX,0),U,26)'="" S ITEM="PICKUP/DEL"
|
|
.I HCPCSD="" S HCPCSD=$P($G(^RMPR(661.1,HCPCS,0)),U,2)
|
|
.S HCPCS=$P($G(^RMPR(661.1,HCPCS,0)),U,1)
|
|
.S WHO=$$GET1^DIQ(200,$P($G(^RMPR(660,RDX,0)),U,27),1)
|
|
.I $G(RDX) S OPEN=$P(^RMPR(660,RDX,0),U,12)
|
|
.I OPEN="" S OPEN="*"
|
|
.E S OPEN=" "
|
|
.S COST=^TMP($J,CODE,RDX)
|
|
.S SOURCE=$P(^RMPR(660,RDX,0),U,14)
|
|
.S DATE=$P(^RMPR(660,RDX,0),U,1),DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)
|
|
.I ITEM="" S ITEM=$P($G(^PRC(441,+$P($G(^RMPR(661,+$P($G(^RMPR(660,RDX,0)),U,6),0)),U,1),0)),U,2)
|
|
.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
|
|
.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
|
|
K ITEM,HCPCSD
|
|
Q
|
|
DESPR ;repair dispaly
|
|
;
|
|
;S CODE="R1"
|
|
;code is user defined
|
|
F S CODE=$O(^TMP($J,CODE)) Q:CODE["RMPR" Q:FL=1 D
|
|
.D HDR
|
|
.S RDX=0
|
|
.F S RDX=$O(^TMP($J,CODE,RDX)) D:RDX'>0 HOLD Q:RDX'>0 Q:FL=1 D
|
|
..S DFN=$P(^RMPR(660,RDX,0),U,2) Q:DFN=""
|
|
..D DEM^VADPT
|
|
..Q:FL=1
|
|
..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
|
|
..I $Y+6>IOSL,IOST'["C-" D HDR
|
|
..W !,$E($P(VADM(1),",",1),1,9)
|
|
..W ?10,$P(VADM(2),"-",3)
|
|
..S TYPE=$P(^RMPR(660,RDX,0),U,4)
|
|
..S QTY=$P(^RMPR(660,RDX,0),U,7)
|
|
..I $P(^RMPR(660,RDX,0),U,17)'="" S HCPCS="#SHIP",ITEM="SHIPPING"
|
|
..S:$G(HCPCS)'["#" HCPCS=$P(^RMPR(661.1,$P(^RMPR(660,RDX,1),U,4),0),U,1)
|
|
..S:$G(HCPCS)'["#" HCPCSD=$P(^RMPR(661.1,$P(^RMPR(660,RDX,1),U,4),0),U,2)
|
|
..I $G(HCPCS)["#" S HCPCSD="SHIPPING"
|
|
..S WHO=$$GET1^DIQ(200,$P($G(^RMPR(660,RDX,0)),U,27),1)
|
|
..S OPEN=""
|
|
..I $G(RDZ) S OPEN=$P(^RMPR(660,RDZ,0),U,12)
|
|
..I OPEN="" S OPEN="*"
|
|
..E S OPEN=" "
|
|
..S COST=^TMP($J,CODE,RDX)
|
|
..S SOURCE=$P(^RMPR(660,RDX,0),U,14)
|
|
..S DATE=$P(^RMPR(660,RDX,0),U,1),DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)
|
|
..S:$G(ITEM)'["SHIPPING" ITEM=$P(^PRC(441,$P(^RMPR(661,$P(^RMPR(660,RDX,0),U,6),0),U,1),0),U,2)
|
|
..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
|
|
..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
|
|
Q
|
|
EXIT ;
|
|
Q
|
|
;END
|