- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR9P21.m
r613 r623 1 RMPR9P21 2 ;;3.0;PROSTHETICS;**90,116,119,133,139**;Feb 09, 1996;Build 4 3 4 EN(RMPRA,RMPRSITE,RMPRPTR) 5 6 7 PRT(RESULTS,RMPRA,RMPRSITE,RMPRPTR) 8 EN2 9 10 11 12 13 14 15 16 17 18 HDR 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 S ^TMP($J,"RMPRPRT",CNT+12)="7. Claim Number8. ID #:"_" "_$P($P(VADM(2),U,2),"-",3)70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 HDR1 87 88 89 90 91 92 93 94 95 96 97 98 EX 99 100 1 RMPR9P21 ;PHX/SPS,HNC,RVD -SEND DATA TO PC TO PRINT PURCHASE CARD ORDER ;4/27/05 2 ;;3.0;PROSTHETICS;**90,116,119,133**;Feb 09, 1996;Build 2 3 ; 4 EN(RMPRA,RMPRSITE,RMPRPTR) ;ENTRY POINT FOR VISTA ROLL AND SCROLL 5 G EN2 6 ; 7 PRT(RESULTS,RMPRA,RMPRSITE,RMPRPTR) ;GUI ENTRY POINT TO PRINT 8 EN2 I RMPRPTR'="WINDOWS" Q 9 K ^TMP($J,"RMPRPRT"),RESULTS 10 D INF^RMPRSIT 11 S %X="^RMPR(664,RMPRA,",%Y="R664(" D %XY^%RCR K %X,%Y,^TMP($J,"RMPRPRT") 12 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),RMPRPAGE=2 13 D ADD^VADPT,DEM^VADPT,ELIG^VADPT 14 S ^TMP($J,"RMPRPRT",0)=" OMB Number 2900-0188 PO#: "_$P($G(^RMPR(664,RMPRA,4)),U,5) 15 S ^TMP($J,"RMPRPRT",1)="By receiving this purchase order you agree to take appropriate measures to" 16 S ^TMP($J,"RMPRPRT",2)="secure the information and ensure the confidentiality of the patient information" 17 S ^TMP($J,"RMPRPRT",3)="is maintained. ORIGINAL PO AND INVOICE MUST BE SUBMITTED TO THE VAMC BELOW" 18 HDR ;PRINT HEADER FOR 2421 ADDRESS INFO 19 S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K 20 S (RMPRT,RMPRB)="",$P(RMPRT,"_",80)="",$P(RMPRB,"-",80)="" 21 S ^TMP($J,"RMPRPRT",CNT+1)=RMPRT 22 S ^TMP($J,"RMPRPRT",CNT+2)="Department of Veterans Affairs"_"|"_"Prosthetic Authorization for Items or Services" 23 S ^TMP($J,"RMPRPRT",CNT+3)=RMPRB 24 S ^TMP($J,"RMPRPRT",CNT+4)="1. Name and Address of Vendor 2. Name and Address of VA Facility" 25 S RMPRV=$P(R664(0),U,4),RMPRST="" 26 I $D(^PRC(440,RMPRV,0)) S RMPRV=^PRC(440,RMPRV,0) D 27 .S RMPRST=$P(RMPRV,U,7),RMPRPHON=$P(RMPRV,U,10) 28 .S RMPRAD1=$P(RMPRV,U,2),RMPRAD2=$P(RMPRV,U,3) 29 .S RMPRCITY=$P(RMPRV,U,6),RMPR90IP=$P(RMPRV,U,8) 30 .S RMPRVACN=$P($G(^PRC(440,$P(R664(0),U,4),2)),U,1) 31 I $D(^DIC(5,+RMPRST,0)) S RMPRST=$P(^(0),U,2) 32 E S RMPRST="NO STATE ON FILE" 33 S SPACE="",LRMPRV=$L($E($P(RMPRV,U,1),1,30)),$P(SPACE," ",40-LRMPRV)="" 34 S ^TMP($J,"RMPRPRT",CNT+5)=" "_$E($P(RMPRV,U,1),1,30)_SPACE_$E(RMPR("NAME"),1,28)_" ,("_$$STA^RMPRUTIL_"/"_$$ROU^RMPRUTIL(RMPRSITE)_")" 35 S LRMPRCTY=$L(RMPRCITY),LRMPRST=$L(RMPRST),LRMPRAD1=$L($E(RMPRAD1,1,35)) 36 S SPACE="",$P(SPACE," ",40-LRMPRAD1)="" 37 S ^TMP($J,"RMPRPRT",CNT+6)=" "_$E(RMPRAD1,1,35)_SPACE_$E(RMPR("ADD"),1,39) 38 S SPACE="",LRMPRAD2=$L($E(RMPRAD2,1,35)),$P(SPACE," ",45-LRMPRAD1)="" 39 I RMPRAD2'="" S ^TMP($J,"RMPRPRT",CNT+7)=" "_$E(RMPRAD2,1,35)_SPACE_RMPR("CITY") 40 S SPACE="",$P(SPACE," ",33-LRMPRCTY-LRMPRST)="" 41 I RMPRAD2="" S ^TMP($J,"RMPRPRT",CNT+7)=" "_RMPRCITY_","_RMPRST_" "_RMPR90IP_SPACE_RMPR("CITY") 42 I RMPRAD2'="" S ^TMP($J,"RMPRPRT",CNT+8)=" "_RMPRCITY_","_RMPRST_" "_RMPR90IP 43 S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K 44 S ^TMP($J,"RMPRPRT",CNT+1)=" "_RMPRPHON_" "_$P(^RMPR(669.9,RMPRSITE,0),U,4) 45 S ^TMP($J,"RMPRPRT",CNT+2)=RMPRB 46 S ^TMP($J,"RMPRPRT",CNT+3)="3. Veterans Name (Last, First, MI) 4. Date of Authorization" 47 S SPACE="",VADM1=$L(VADM(1)) 48 S ^TMP($J,"RMPRPRT",CNT+4)=" "_VADM(1) S Y=$P(R664(0),U,1) D DD^%DT 49 S SPACE="",$P(SPACE," ",40-VADM1)="" 50 S ^TMP($J,"RMPRPRT",CNT+4)=^TMP($J,"RMPRPRT",CNT+4)_SPACE_Y 51 I $D(RMPRMOR) S ^TMP($J,"RMPRPRT",CNT+5)=RMPRB D HDR1 Q 52 S ^TMP($J,"RMPRPRT",CNT+5)=RMPRB S RMPRODTE=Y 53 S RMPRDELD="" I $D(R664(3)),$P(R664(3),U,2)]"" S Y=$P(R664(3),U,2) D DD^%DT S RMPRDELD=Y 54 S ^TMP($J,"RMPRPRT",CNT+6)="5. Veterans Address 6. Date Required" 55 S SPACE="",VAPA1=$L(VAPA(1)),$P(SPACE," ",40-VAPA1)="" 56 S ^TMP($J,"RMPRPRT",CNT+7)=" "_VAPA(1)_SPACE_RMPRDELD 57 S SPACE="",VAPA4=$L(VAPA(4)),VAPA5=$P($L(VAPA(5)),U,2),VAPA6=$L(VAPA(6)),$P(SPACE," ",27-VAPA4-VAPA5-VAPA6)="" 58 I VAPA(2)="" S ^TMP($J,"RMPRPRT",CNT+8)=" "_VAPA(4)_","_$P(VAPA(5),U,2)_" "_VAPA(6)_SPACE_$E(RMPRB,1,40) 59 I VAPA(2)="" S ^TMP($J,"RMPRPRT",CNT+9)=" 9. Authority For Issuance CFR 17.115" 60 S SPACE="",VAPA8=$L(VAPA(8)),$P(SPACE," ",40-VAPA8)="" 61 I VAPA(2)="" S ^TMP($J,"RMPRPRT",CNT+10)=" "_VAPA(8)_SPACE_"CHARGE MEDICAL APPROPRIATION" 62 S SPACE="",VAPA2=$L(VAPA(2)),$P(SPACE," ",31-VAPA2)="" 63 I VAPA(2)'="" S ^TMP($J,"RMPRPRT",CNT+8)=" "_VAPA(2)_SPACE_$E(RMPRB,1,40) 64 S SPACE="",$P(SPACE," ",30-VAPA4-VAPA5-VAPA6)="" 65 I VAPA(2)'="" S ^TMP($J,"RMPRPRT",CNT+9)=" "_VAPA(4)_","_$P(VAPA(5),U,2)_" "_VAPA(6)_SPACE_"9. Authority For Issuance CFR 17.115" 66 S SPACE="",$P(SPACE," ",40-VAPA8)="" 67 I VAPA(2)'="" S ^TMP($J,"RMPRPRT",CNT+10)=" "_VAPA(8)_SPACE_"CHARGE MEDICAL APPROPRIATION" 68 S ^TMP($J,"RMPRPRT",CNT+11)=RMPRB 69 S ^TMP($J,"RMPRPRT",CNT+12)="7. Claim Number "_VAEL(7)_" 8. ID #:"_" "_$P($P(VADM(2),U,2),"-",3) 70 S ^TMP($J,"RMPRPRT",CNT+13)=RMPRB 71 S ^TMP($J,"RMPRPRT",CNT+14)="10. Statistical Data 11. FOB Point 12. Discount 13. Delivery Time" 72 S R664("E")=$O(R664(1,0)),CAT=$P(R664(1,R664("E"),0),U,10) 73 S RMPRCAT=$S(CAT=1:"SC/OP",CAT=2:"SC/IP",CAT=3:"NSC/IP",CAT=4:"NSC/OP",1:"") 74 S SPE=$P(R664(1,R664("E"),0),U,11) 75 S RMPRSCAT=$S(SPE=1:"SPECIAL LEGISLATION",SPE=2:"A&A",SPE=3:"PHC",SPE=4:"ELIGIBILITY REFORM",1:"") 76 S ^TMP($J,"RMPRPRT",CNT+15)=" "_RMPRCAT_" "_RMPRSCAT S:+$P(R664(0),U,10) RMPRFOB=$P(R664(0),U,10) 77 S SPACE="",LRMPRCAT=$L(RMPRCAT),LRMPSCAT=$L(RMPRSCAT),$P(SPACE," ",29-LRMPRCAT-LRMPSCAT)="" 78 S ^TMP($J,"RMPRPRT",CNT+15)=^TMP($J,"RMPRPRT",CNT+15)_SPACE_$S($D(RMPRFOB):"ORIGIN",1:"DEST ")_" % " 79 I $D(R664(2)) S ^TMP($J,"RMPRPRT",CNT+15)=^TMP($J,"RMPRPRT",CNT+15)_$P(R664(2),U,6) 80 I $D(R664(3)) S ^TMP($J,"RMPRPRT",CNT+15)=^TMP($J,"RMPRPRT",CNT+15)_" "_$P(R664(3),U,3)_" Days" 81 S ^TMP($J,"RMPRPRT",CNT+16)=RMPRB 82 S ^TMP($J,"RMPRPRT",CNT+17)="14. Delivery To: " 83 S:$D(R664(3)) ^TMP($J,"RMPRPRT",CNT+17)=^TMP($J,"RMPRPRT",CNT+17)_$P(R664(3),U) 84 S ^TMP($J,"RMPRPRT",CNT+18)=" Attention: "_$P(R664(3),U,4) 85 S ^TMP($J,"RMPRPRT",CNT+19)=RMPRB 86 HDR1 ;HEADER FOR 10-2421 87 S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K 88 S ^TMP($J,"RMPRPRT",CNT+1)=" 15. DESCRIPTION OF ITEMS OR SERVICES AUTHORIZED" 89 S ^TMP($J,"RMPRPRT",CNT+2)=RMPRB 90 S ^TMP($J,"RMPRPRT",CNT+3)="ITEM NUMBER DESCRIPTION QUANTITY UNIT UNIT AMOUNT" 91 S ^TMP($J,"RMPRPRT",CNT+4)=" ORDERED PRICE" 92 S ^TMP($J,"RMPRPRT",CNT+5)=RMPRB 93 Q:$D(RMPRMOR) 94 S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K 95 D ^RMPR9P22 96 D:'$D(RMPRMOR1) CON^RMPR9P22 97 M RESULTS=^TMP($J,"RMPRPRT") 98 EX ;Common Exit Point 99 K VADM,CP,DFN,CAT,DIC,R664,RMPRA,RMPACT,RMPRAD1,RMPRAD2,RMPRAMT,RMPRAMT1,RMPRB,RMPRCAT,RMPRCH,RMPRCITY,RMPRDELD,RMPRI,RMPRI1,RMPRIT,RMPRN,RMPRODTE,RMPRST,RMPRPHON,RMPRT,RMPRTOT,RMPRUT,RMPRV,RMPR90IP,RO,RP,J1,RTN,RMPRMOR1,RMPRPRIV 100 K SPE,VA,VAEL,VAPA,VAERR,RZZZ,RX,RX1,RDUZ,RC,RMPRACT,RMPRSCAT,RMPRDISC,RMPRAMTN,DIR,DIRUT,RMPRAMT2,RMPRFOB,RMPRDA,RMPRMOR,RMPRPAGE,RMPRPRIV,RMPRX,RMPR90,J,K,N D ^%ZISC Q
Note:
See TracChangeset
for help on using the changeset viewer.
