| 1 | RMPRP55 ;PHX/DWL/HNB-PRINT 10-55 ;3/17/03 13:05
|
|---|
| 2 | ;;3.0;PROSTHETICS;**20,55,77**;Feb 09, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | ; ODJ - patch 55 - 1/29/01 - replace 121 hard coded mail symbol with
|
|---|
| 5 | ; call to site param. extrinsic
|
|---|
| 6 | ; nois AUG-1097-32118
|
|---|
| 7 | ; RVD 3/17/03 patch #77 - allow queing to p-message. IO to ION
|
|---|
| 8 | ;
|
|---|
| 9 | I '$D(RMPR) D DIV4^RMPRSIT G:$D(X) EXIT
|
|---|
| 10 | I $D(RMPRA) G ZIS
|
|---|
| 11 | EN ;ENTRY POINT FOR REPRINTING A 10-55
|
|---|
| 12 | D DIV4^RMPRSIT G:$D(X) EXIT
|
|---|
| 13 | S DIC="^RMPR(664,",DIC(0)="AEMQ",DIC("W")="D EN2^RMPRD1"
|
|---|
| 14 | S DIC("A")="Select Transaction or Patient Name: "
|
|---|
| 15 | S DIC("S")="I $D(^RMPR(664,Y,1)) S R1=$O(^RMPR(664,Y,1,0)) I R1 S RX=$P(^(R1,0),U,13) S:$D(^RMPR(660,+RX,0)) RX=$P(^(0),U,13) I RX=1!(RX=10) I '$D(^RMPR(664,""AP"",RMPR(""STA""),Y))"
|
|---|
| 16 | D ^DIC G:+Y<1 EXIT
|
|---|
| 17 | S RMPRA=+Y,RMPRACT=1 I $P(^RMPR(664,+Y,0),U,5) D M2^RMPRM G EXIT
|
|---|
| 18 | D PR^RMPR21A I %'>0 G EXIT
|
|---|
| 19 | S RX=^RMPR(664,RMPRA,0)
|
|---|
| 20 | ZIS ;
|
|---|
| 21 | I $P(^RMPR(669.9,RMPRSITE,0),U,5) S IOP="Q;"_$P(^%ZIS(1,$P(^(0),U,5),0),U,1),%ZIS="MQ" D ^%ZIS G:POP EXIT G PT
|
|---|
| 22 | S %ZIS="MQ" D ^%ZIS G:POP EXIT I $D(IO("Q")) S ZTIO=ION G PT
|
|---|
| 23 | U IO
|
|---|
| 24 | EN1 ;ADDRESS DEFINED
|
|---|
| 25 | W:$E(IOST)["C" @IOF S %X="^RMPR(664,RMPRA,",%Y="R55(" D %XY^%RCR
|
|---|
| 26 | S Y=DT D DD^%DT S DATE=Y,RMPRTT="" W:$D(RMPRACT) ?30,"****DUPLICATE COPY****" I $P($G(R55(4)),U,8)=1 W ?30,"***WORKING COPY***"
|
|---|
| 27 | W !!!,?5,"DEPARTMENT OF VETERANS AFFAIRS" W !,?5,RMPR("NAME"),!,?5,RMPR("ADD"),!,?5,RMPR("CITY")
|
|---|
| 28 | ADD ;ADDRESS INFO
|
|---|
| 29 | S RMPRUP=0,I=0,RMPRV=$P(^RMPR(664,RMPRA,0),U,4),RMPRV=^PRC(440,RMPRV,0),RMPRST=$P(RMPRV,U,7),RMPRST=$S(RMPRST="":"NO STATE",1:$P(^DIC(5,RMPRST,0),U,2)),RMPRDUZ="",RMPRDUZ=$P(^RMPR(664,RMPRA,0),U,9),RMPRDUZ=$P(^VA(200,RMPRDUZ,0),U,1)
|
|---|
| 30 | S RMPRDFN=$P(^RMPR(664,RMPRA,0),U,2)
|
|---|
| 31 | S I=$O(^RMPR(664,RMPRA,1,I))
|
|---|
| 32 | S RMPRI=$P(^RMPR(664,RMPRA,1,I,0),U,1)
|
|---|
| 33 | S RMPRUP=$O(^RMPR(665,"C",RMPRI,RMPRDFN,RMPRUP))
|
|---|
| 34 | S:RMPRUP RMPRSN=$P(^RMPR(665,RMPRDFN,5,RMPRUP,0),U,3)
|
|---|
| 35 | ;Should call VADPT not look at global directly
|
|---|
| 36 | S RMPRNAM=$P(^DPT(RMPRDFN,0),U,1)
|
|---|
| 37 | S RMPRSSN=$P(^DPT(RMPRDFN,0),U,9)
|
|---|
| 38 | S RMPRTN=$P(^RMPR(664,RMPRA,0),U,7)
|
|---|
| 39 | WRITE W !!!!!,?5,$P(RMPRV,U,1),?53,"In Reply Refer to:",?73,$$STA^RMPRUTIL_"-",$$ROU^RMPRUTIL(RMPRSITE),!,?5,$P(RMPRV,U,2),?53,RMPRNAM
|
|---|
| 40 | W !?5,$P(RMPRV,U,6),", ",RMPRST," ",$P(RMPRV,U,8)
|
|---|
| 41 | W ?53,$E(RMPRSSN,1,3)_"-"_$E(RMPRSSN,4,5)_"-"_$E(RMPRSSN,6,9),!,?53,RMPRTN
|
|---|
| 42 | W !!,?5,$P(RMPRV,U,1),!!,?5,"With reference to your request of ",?39,$E($P(^RMPR(664,RMPRA,0),U,1),4,5),"/",$E($P(^RMPR(664,RMPRA,0),U,1),6,7),"/",$E($P(^RMPR(664,RMPRA,0),U,1),2,3),", authority is granted to repair "
|
|---|
| 43 | W !,?5,"the appliance described below for the above-named veteran."
|
|---|
| 44 | DESC ;ITEM,DES,COST,QTY
|
|---|
| 45 | S $P(LINE,".",75)=""
|
|---|
| 46 | W !!,?5,LINE,!,?23,"DESCRIPTION OF APPLIANCE OR REPAIR",!,?63,"Unit",?73,"Total",!,?5,"Item",?11,"Name",?32,"Serial Number",?55,"Qty",?63,"Price",?73,"Cost",!,?5,LINE
|
|---|
| 47 | S I=0,RMPRTO=0 F I=0:0 S I=$O(^RMPR(664,RMPRA,1,I)),RMPRDFN="" G COST:I'>0 D LIST
|
|---|
| 48 | COST S X=RMPRTO,X2="2$",X3=9 D COMMA^%DTC
|
|---|
| 49 | W !!,?5,"The total cost, not including mailing cost, will not exceed ",?RR+1,X,!!,?5,"When repairs are completed, please attach the original of this letter to"
|
|---|
| 50 | W !,?5,"the original copy of your invoice covering repair charges. Your invoice,",!,?5,"in original and one copy should then be forwarded to this office for"
|
|---|
| 51 | W !?5,"payment.",!!?5,"Please retain the duplicate copy of this letter for your files."
|
|---|
| 52 | W !!,?5,"Sincerely,",!!!!,?5,RMPR("SIG"),", Chief",!,?5,RMPR("SBT")
|
|---|
| 53 | END S L=19-RMPRTT F I=1:1:L W !
|
|---|
| 54 | W ?5,"Initiator: ",RMPRDUZ,?45,"REF: ",RMPRA,?64,"ADP FORM 10-55" D:$D(RMPRPRIV) ^RMPRP23
|
|---|
| 55 | EXIT K RMPRACT,ZTSK,RX,RMPRI,RMPRTN,RMPRDS,RMPRQT,RMPRCT,RMPRTO,RMPRUP,RR,I,DATE,DIC,RG,L,LINE,RMPRA,RMPRDFN,RMPRIS,RMPRNAM,RMPRNM,RMPRSN,RMPRSSN,RMPRST,RMPRTT,RMPRPRIV,RMPRCC,RXT,RX1
|
|---|
| 56 | K RMPRV,X2,X3,RMPRDUZ,RMPRI1,RMPRIT,RMPRN,VA,VAEL,RZZZ,VAERR,Y,RMPRPRIV,RTX D ^%ZISC Q
|
|---|
| 57 | LIST S RR=^RMPR(664,RMPRA,1,I,0),RMPRIS=$P(RR,U,5),RMPRIS=$P(^PRCD(420.5,RMPRIS,0),U,1),RMPRI=$P(RR,U,1),RMPRI=$P(^RMPR(661,RMPRI,0),U,1),RMPRI=^PRC(441,RMPRI,0),RMPRNM=$P(RMPRI,U,2),RMPRI=$P(RMPRI,U,1)
|
|---|
| 58 | S RMPRCT=$P(RR,U,3),RMPRQT=$P(RR,U,4),RMPRTO=(RMPRCT*RMPRQT)+RMPRTO,RMPRDS=$P(RR,U,2),X=RMPRCT,X2="2$",X3=9 D COMMA^%DTC S RR=$L(X),RR=79-RR W !,?5,RMPRI,?11,$E(RMPRNM,1,18),?32,$G(RMPRSN),?56,RMPRQT,?59,X,!,?11,RMPRDS
|
|---|
| 59 | I $P(^RMPR(664,RMPRA,0),U,10)!($P(^(0),U,11)) S RR=$S($P(^(0),U,11):$P(^(0),U,11),1:$P(^(0),U,10)) I RR S X=RR,X2="2$",X3=9 D COMMA^%DTC S RR=$L(X),RR=79-RR W !,?32,"Shipping Charge: ",?59,X,!
|
|---|
| 60 | I $D(R55(1,1,1,0)) F RTX=0:0 S RTX=$O(R55(1,1,1,RTX)) Q:RTX'>0 W !,?5,R55(1,1,1,RTX,0)
|
|---|
| 61 | CNTER S RMPRTT=(RMPRTT+1) K R55 Q
|
|---|
| 62 | PT F RG="DT","RMPRSITE","RMPRA","RMPRUP","RMPR(" S ZTSAVE(RG)="" S:$D(RMPRACT) ZTSAVE("RMPRACT")="" S:$D(RMPRPRIV) ZTSAVE("RMPRPRIV")=""
|
|---|
| 63 | I $D(IO("Q")) S ZTRTN="EN1^RMPRP55",ZTDTH=$H,ZTDESC="PROSTHETICS PRINT OF 10-55",ZTIO=ION D ^%ZTLOAD
|
|---|
| 64 | W !,$S($D(ZTSK):"<REQUEST QUEUED!>",1:"<REQUEST DID NOT QUEUE!>")
|
|---|
| 65 | D HOME^%ZIS G EXIT
|
|---|
