Changeset 636 for FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRP21.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• PROSTHETICS-RMPR-RMPO-RMPS/RMPRP21.m (modified) (5 diffs)

FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRP21.m

@@ -1 +1 @@
 RMPRP21 ;PHX/RFM-PRINT 10-2421 ;8/29/1994
- ;;3.0;PROSTHETICS;**3,19,55,90,129,133,139**;Feb 09, 1996;Build 4
+ ;;3.0;PROSTHETICS;**3,19,55,90,129,133**;Feb 09, 1996;Build 2
  ;
  ; ODJ - patch 55 - 1/29/01 - extrinsic to get mail routing code
@@ -6 +6 @@
  ;                            nois AUG-1097-32118
  ;
- I '$D(RMPR)!'$D(RMPRSITE) D DIV4^RMPRSIT Q:$D(X)
+ I '$D(RMPR) D DIV4^RMPRSIT Q:$D(X)
  I +$P(^RMPR(669.9,RMPRSITE,0),U,5) I $D(RMPRA)&($D(^%ZIS(1,$P(^RMPR(669.9,RMPRSITE,0),U,5),0))) S IOP="Q;"_$P(^(0),U,1) S %ZIS="MQ" D ^%ZIS G:POP EX S ZTIO=ION G PT
  I $D(RMPRA)&('$P(^RMPR(669.9,RMPRSITE,0),U,5)) G ZIS
@@ -15 +15 @@
  S DIC("W")="D EN2^RMPRD1" D ^DIC G:Y<0 EX S RMPRA=+Y I $P(^RMPR(664,+Y,0),U,5) D M2^RMPRM
  D PR^RMPR21A I %'>0 G EX
- I +$P(^RMPR(669.9,RMPRSITE,0),U,5) I $D(RMPRA)&($D(^%ZIS(1,$P(^RMPR(669.9,RMPRSITE,0),U,5),0))) S IOP="Q;"_$P(^(0),U,1),%ZIS="Q" D ^%ZIS G:POP EX S ZTIO=ION G PT
+ ;I +$P(^RMPR(669.9,RMPRSITE,0),U,5) I $D(RMPRA)&($D(^%ZIS(1,$P(^RMPR(669.9,RMPRSITE,0),U,5),0))) S IOP="Q;"_$P(^(0),U,1),%ZIS="Q" D ^%ZIS G:POP EX S ZTIO=ION G PT
 ZIS S %ZIS="QM" D ^%ZIS G:POP EX
  I '$D(IO("Q")) U IO G PRT
@@ -23 +23 @@
 PRT ;ENTRY POINT TO PRINT 2421S
  S %X="^RMPR(664,RMPRA,",%Y="R664(" D %XY^%RCR K %X,%Y
- S RDUZ=$P(R664(0),U,9),RDUZ=$P(^VA(200,RDUZ,0),U,1),DFN=$P(R664(0),U,2),RTN=$P(R664(0),U,7),CP=$P(R664(0),U,6),CP=$P($G(^PRCS(410,CP,0)),U,1),RMPRPAGE=2
+ S RDUZ=$P(R664(0),U,9),RDUZ=$P(^VA(200,RDUZ,0),U,1),DFN=$P(R664(0),U,2),RTN=$P(R664(0),U,7),CP=$P(R664(0),U,6),CP=$P(^PRCS(410,CP,0),U,1),RMPRPAGE=2
  D ADD^VADPT,DEM^VADPT,ELIG^VADPT
  W:$Y>0 @IOF W ?20,"OMB Number 2900-0188",?50,"PO#: "
@@ -59 +59 @@
  I VAPA(2)'="" W ?5,VAPA(2),?40,$E(RMPRB,1,40),!,?5,VAPA(4)_","_$P(VAPA(5),U,2)_" "_VAPA(6),?40,"9. Authority For Issuance  CFR 17.115",!,?5,VAPA(8),?43,"CHARGE MEDICAL APPROPRIATION"
  W !,RMPRB
- ;Remove claim number print in *139 since it held SSN at times
- W !,"7. Claim Number",?40,"8. SSN"_" "_$P($P(VADM(2),U,2),"-",3),!,RMPRB,!,"10. Statistical Data",?30,"11. FOB Point",?46,"12. Discount",?61,"13. Delivery Time"
+ W !,"7. Claim Number"_" "_VAEL(7),?40,"8. SSN"_" "_$P($P(VADM(2),U,2),"-",3),!,RMPRB,!,"10. Statistical Data",?30,"11. FOB Point",?46,"12. Discount",?61,"13. Delivery Time"
  S R664("E")=$O(R664(1,0)),CAT=$P(R664(1,R664("E"),0),U,10)
  S RMPRCAT=$S(CAT=1:"SC/OP",CAT=2:"SC/IP",CAT=3:"NSC/IP",CAT=4:"NSC/OP",1:"") S SPE=$P(R664(1,R664("E"),0),U,11)