- RMPR9P21 ;PHX/SPS,HNC,RVD -SEND DATA TO PC TO PRINT PURCHASE CARD ORDER ;4/27/05
- ;;3.0;PROSTHETICS;**90,116,119,133,139,153**;Feb 09, 1996;Build 10
- ;
- EN(RMPRA,RMPRSITE,RMPRPTR) ;ENTRY POINT FOR VISTA ROLL AND SCROLL
- G EN2
- ;
- PRT(RESULTS,RMPRA,RMPRSITE,RMPRPTR) ;GUI ENTRY POINT TO PRINT
- EN2 I RMPRPTR'="WINDOWS" Q
- K ^TMP($J,"RMPRPRT"),RESULTS
- D INF^RMPRSIT
- S %X="^RMPR(664,RMPRA,",%Y="R664(" D %XY^%RCR K %X,%Y,^TMP($J,"RMPRPRT")
- 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
- D ADD^VADPT,DEM^VADPT,ELIG^VADPT
- S ^TMP($J,"RMPRPRT",0)=" OMB Number 2900-0188 PO#: "_$P($G(^RMPR(664,RMPRA,4)),U,5)
- S ^TMP($J,"RMPRPRT",1)="By receiving this purchase order you agree to take appropriate measures to"
- S ^TMP($J,"RMPRPRT",2)="secure the information and ensure the confidentiality of the patient information"
- S ^TMP($J,"RMPRPRT",3)="is maintained. ORIGINAL PO AND INVOICE MUST BE SUBMITTED TO THE VAMC BELOW"
- HDR ;PRINT HEADER FOR 2421 ADDRESS INFO
- S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
- S (RMPRT,RMPRB)="",$P(RMPRT,"_",80)="",$P(RMPRB,"-",80)=""
- S ^TMP($J,"RMPRPRT",CNT+1)=RMPRT
- S ^TMP($J,"RMPRPRT",CNT+2)="Department of Veterans Affairs"_"|"_"Prosthetic Authorization for Items or Services"
- S ^TMP($J,"RMPRPRT",CNT+3)=RMPRB
- S ^TMP($J,"RMPRPRT",CNT+4)="1. Name and Address of Vendor 2. Name and Address of VA Facility"
- S RMPRV=$P(R664(0),U,4),RMPRST=""
- I $D(^PRC(440,RMPRV,0)) S RMPRV=^PRC(440,RMPRV,0) D
- .S RMPRST=$P(RMPRV,U,7),RMPRPHON=$P(RMPRV,U,10)
- .S RMPRAD1=$P(RMPRV,U,2),RMPRAD2=$P(RMPRV,U,3)
- .S RMPRCITY=$P(RMPRV,U,6),RMPR90IP=$P(RMPRV,U,8)
- .S RMPRVACN=$P($G(^PRC(440,$P(R664(0),U,4),2)),U,1)
- I $D(^DIC(5,+RMPRST,0)) S RMPRST=$P(^(0),U,2)
- E S RMPRST="NO STATE ON FILE"
- S SPACE="",LRMPRV=$L($E($P(RMPRV,U,1),1,30)),$P(SPACE," ",40-LRMPRV)=""
- S ^TMP($J,"RMPRPRT",CNT+5)=" "_$E($P(RMPRV,U,1),1,30)_SPACE_$E(RMPR("NAME"),1,28)_" ,("_$$STA^RMPRUTIL_"/"_$$ROU^RMPRUTIL(RMPRSITE)_")"
- S LRMPRCTY=$L(RMPRCITY),LRMPRST=$L(RMPRST),LRMPRAD1=$L($E(RMPRAD1,1,35))
- S SPACE="",$P(SPACE," ",40-LRMPRAD1)=""
- S ^TMP($J,"RMPRPRT",CNT+6)=" "_$E(RMPRAD1,1,35)_SPACE_$E(RMPR("ADD"),1,39)
- S SPACE="",LRMPRAD2=$L($E(RMPRAD2,1,35)),$P(SPACE," ",45-LRMPRAD1)=""
- I RMPRAD2'="" S ^TMP($J,"RMPRPRT",CNT+7)=" "_$E(RMPRAD2,1,35)_SPACE_RMPR("CITY")
- S SPACE="",$P(SPACE," ",33-LRMPRCTY-LRMPRST)=""
- I RMPRAD2="" S ^TMP($J,"RMPRPRT",CNT+7)=" "_RMPRCITY_","_RMPRST_" "_RMPR90IP_SPACE_RMPR("CITY")
- I RMPRAD2'="" S ^TMP($J,"RMPRPRT",CNT+8)=" "_RMPRCITY_","_RMPRST_" "_RMPR90IP
- S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
- S ^TMP($J,"RMPRPRT",CNT+1)=" "_RMPRPHON_" "_$P(^RMPR(669.9,RMPRSITE,0),U,4)
- S ^TMP($J,"RMPRPRT",CNT+2)=RMPRB
- S ^TMP($J,"RMPRPRT",CNT+3)="3. Veterans Name (Last, First, MI) 4. Date of Authorization"
- S SPACE="",VADM1=$L(VADM(1))
- S ^TMP($J,"RMPRPRT",CNT+4)=" "_VADM(1) S Y=$P(R664(0),U,1) D DD^%DT
- S SPACE="",$P(SPACE," ",40-VADM1)=""
- S ^TMP($J,"RMPRPRT",CNT+4)=^TMP($J,"RMPRPRT",CNT+4)_SPACE_Y
- I $D(RMPRMOR) S ^TMP($J,"RMPRPRT",CNT+5)=RMPRB D HDR1 Q
- S ^TMP($J,"RMPRPRT",CNT+5)=RMPRB S RMPRODTE=Y
- S RMPRDELD="" I $D(R664(3)),$P(R664(3),U,2)]"" S Y=$P(R664(3),U,2) D DD^%DT S RMPRDELD=Y
- S ^TMP($J,"RMPRPRT",CNT+6)="5. Veterans Address 6. Date Required"
- S SPACE="",VAPA1=$L(VAPA(1)),$P(SPACE," ",40-VAPA1)=""
- S ^TMP($J,"RMPRPRT",CNT+7)=" "_VAPA(1)_SPACE_RMPRDELD
- S SPACE="",VAPA4=$L(VAPA(4)),VAPA5=$P($L(VAPA(5)),U,2),VAPA6=$L(VAPA(6)),$P(SPACE," ",27-VAPA4-VAPA5-VAPA6)=""
- I VAPA(2)="" S ^TMP($J,"RMPRPRT",CNT+8)=" "_VAPA(4)_","_$P(VAPA(5),U,2)_" "_VAPA(6)_SPACE_$E(RMPRB,1,40)
- I VAPA(2)="" S ^TMP($J,"RMPRPRT",CNT+9)=" 9. Authority For Issuance CFR 17.115"
- S SPACE="",VAPA8=$L(VAPA(8)),$P(SPACE," ",40-VAPA8)=""
- I VAPA(2)="" S ^TMP($J,"RMPRPRT",CNT+10)=" "_VAPA(8)_SPACE_"CHARGE MEDICAL APPROPRIATION"
- S SPACE="",VAPA2=$L(VAPA(2)),$P(SPACE," ",31-VAPA2)=""
- I VAPA(2)'="" S ^TMP($J,"RMPRPRT",CNT+8)=" "_VAPA(2)_SPACE_$E(RMPRB,1,40)
- S SPACE="",$P(SPACE," ",30-VAPA4-VAPA5-VAPA6)=""
- 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"
- S SPACE="",$P(SPACE," ",40-VAPA8)=""
- I VAPA(2)'="" S ^TMP($J,"RMPRPRT",CNT+10)=" "_VAPA(8)_SPACE_"CHARGE MEDICAL APPROPRIATION"
- S ^TMP($J,"RMPRPRT",CNT+11)=RMPRB
- ;Remove claim number print in *139 since it held SSN at times
- ;Remove field 8.ID # print in *153 which held last 4 digits of SSN
- S ^TMP($J,"RMPRPRT",CNT+12)="7. Claim Number 8. ID #:"
- S ^TMP($J,"RMPRPRT",CNT+13)=RMPRB
- S ^TMP($J,"RMPRPRT",CNT+14)="10. Statistical Data 11. FOB Point 12. Discount 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)
- S RMPRSCAT=$S(SPE=1:"SPECIAL LEGISLATION",SPE=2:"A&A",SPE=3:"PHC",SPE=4:"ELIGIBILITY REFORM",1:"")
- S ^TMP($J,"RMPRPRT",CNT+15)=" "_RMPRCAT_" "_RMPRSCAT S:+$P(R664(0),U,10) RMPRFOB=$P(R664(0),U,10)
- S SPACE="",LRMPRCAT=$L(RMPRCAT),LRMPSCAT=$L(RMPRSCAT),$P(SPACE," ",29-LRMPRCAT-LRMPSCAT)=""
- S ^TMP($J,"RMPRPRT",CNT+15)=^TMP($J,"RMPRPRT",CNT+15)_SPACE_$S($D(RMPRFOB):"ORIGIN",1:"DEST ")_" % "
- I $D(R664(2)) S ^TMP($J,"RMPRPRT",CNT+15)=^TMP($J,"RMPRPRT",CNT+15)_$P(R664(2),U,6)
- I $D(R664(3)) S ^TMP($J,"RMPRPRT",CNT+15)=^TMP($J,"RMPRPRT",CNT+15)_" "_$P(R664(3),U,3)_" Days"
- S ^TMP($J,"RMPRPRT",CNT+16)=RMPRB
- S ^TMP($J,"RMPRPRT",CNT+17)="14. Delivery To: "
- S:$D(R664(3)) ^TMP($J,"RMPRPRT",CNT+17)=^TMP($J,"RMPRPRT",CNT+17)_$P(R664(3),U)
- S ^TMP($J,"RMPRPRT",CNT+18)=" Attention: "_$P(R664(3),U,4)
- S ^TMP($J,"RMPRPRT",CNT+19)=RMPRB
- HDR1 ;HEADER FOR 10-2421
- S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
- S ^TMP($J,"RMPRPRT",CNT+1)=" 15. DESCRIPTION OF ITEMS OR SERVICES AUTHORIZED"
- S ^TMP($J,"RMPRPRT",CNT+2)=RMPRB
- S ^TMP($J,"RMPRPRT",CNT+3)="ITEM NUMBER DESCRIPTION QUANTITY UNIT UNIT AMOUNT"
- S ^TMP($J,"RMPRPRT",CNT+4)=" ORDERED PRICE"
- S ^TMP($J,"RMPRPRT",CNT+5)=RMPRB
- Q:$D(RMPRMOR)
- S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
- D ^RMPR9P22
- D:'$D(RMPRMOR1) CON^RMPR9P22
- S K="" F S K=$O(^TMP($J,"RMPRPRT",K)) Q:K="" S CNT=K
- D ^RMPR9P23
- M RESULTS=^TMP($J,"RMPRPRT")
- EX ;Common Exit Point
- 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
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR9P21 7090 printed Jan 18, 2025@03:34:50 Page 2
- RMPR9P21 ;PHX/SPS,HNC,RVD -SEND DATA TO PC TO PRINT PURCHASE CARD ORDER ;4/27/05
- +1 ;;3.0;PROSTHETICS;**90,116,119,133,139,153**;Feb 09, 1996;Build 10
- +2 ;
- EN(RMPRA,RMPRSITE,RMPRPTR) ;ENTRY POINT FOR VISTA ROLL AND SCROLL
- +1 GOTO EN2
- +2 ;
- PRT(RESULTS,RMPRA,RMPRSITE,RMPRPTR) ;GUI ENTRY POINT TO PRINT
- EN2 IF RMPRPTR'="WINDOWS"
- QUIT
- +1 KILL ^TMP($JOB,"RMPRPRT"),RESULTS
- +2 DO INF^RMPRSIT
- +3 SET %X="^RMPR(664,RMPRA,"
- SET %Y="R664("
- DO %XY^%RCR
- KILL %X,%Y,^TMP($JOB,"RMPRPRT")
- +4 SET RDUZ=$PIECE(R664(0),U,9)
- SET RDUZ=$PIECE(^VA(200,RDUZ,0),U,1)
- SET DFN=$PIECE(R664(0),U,2)
- SET RTN=$PIECE(R664(0),U,7)
- SET CP=$PIECE(R664(0),U,6)
- SET RMPRPAGE=2
- +5 DO ADD^VADPT
- DO DEM^VADPT
- DO ELIG^VADPT
- +6 SET ^TMP($JOB,"RMPRPRT",0)=" OMB Number 2900-0188 PO#: "_$PIECE($GET(^RMPR(664,RMPRA,4)),U,5)
- +7 SET ^TMP($JOB,"RMPRPRT",1)="By receiving this purchase order you agree to take appropriate measures to"
- +8 SET ^TMP($JOB,"RMPRPRT",2)="secure the information and ensure the confidentiality of the patient information"
- +9 SET ^TMP($JOB,"RMPRPRT",3)="is maintained. ORIGINAL PO AND INVOICE MUST BE SUBMITTED TO THE VAMC BELOW"
- HDR ;PRINT HEADER FOR 2421 ADDRESS INFO
- +1 SET K=""
- FOR
- SET K=$ORDER(^TMP($JOB,"RMPRPRT",K))
- if K=""
- QUIT
- SET CNT=K
- +2 SET (RMPRT,RMPRB)=""
- SET $PIECE(RMPRT,"_",80)=""
- SET $PIECE(RMPRB,"-",80)=""
- +3 SET ^TMP($JOB,"RMPRPRT",CNT+1)=RMPRT
- +4 SET ^TMP($JOB,"RMPRPRT",CNT+2)="Department of Veterans Affairs"_"|"_"Prosthetic Authorization for Items or Services"
- +5 SET ^TMP($JOB,"RMPRPRT",CNT+3)=RMPRB
- +6 SET ^TMP($JOB,"RMPRPRT",CNT+4)="1. Name and Address of Vendor 2. Name and Address of VA Facility"
- +7 SET RMPRV=$PIECE(R664(0),U,4)
- SET RMPRST=""
- +8 IF $DATA(^PRC(440,RMPRV,0))
- SET RMPRV=^PRC(440,RMPRV,0)
- Begin DoDot:1
- +9 SET RMPRST=$PIECE(RMPRV,U,7)
- SET RMPRPHON=$PIECE(RMPRV,U,10)
- +10 SET RMPRAD1=$PIECE(RMPRV,U,2)
- SET RMPRAD2=$PIECE(RMPRV,U,3)
- +11 SET RMPRCITY=$PIECE(RMPRV,U,6)
- SET RMPR90IP=$PIECE(RMPRV,U,8)
- +12 SET RMPRVACN=$PIECE($GET(^PRC(440,$PIECE(R664(0),U,4),2)),U,1)
- End DoDot:1
- +13 IF $DATA(^DIC(5,+RMPRST,0))
- SET RMPRST=$PIECE(^(0),U,2)
- +14 IF '$TEST
- SET RMPRST="NO STATE ON FILE"
- +15 SET SPACE=""
- SET LRMPRV=$LENGTH($EXTRACT($PIECE(RMPRV,U,1),1,30))
- SET $PIECE(SPACE," ",40-LRMPRV)=""
- +16 SET ^TMP($JOB,"RMPRPRT",CNT+5)=" "_$EXTRACT($PIECE(RMPRV,U,1),1,30)_SPACE_$EXTRACT(RMPR("NAME"),1,28)_" ,("_$$STA^RMPRUTIL_"/"_$$ROU^RMPRUTIL(RMPRSITE)_")"
- +17 SET LRMPRCTY=$LENGTH(RMPRCITY)
- SET LRMPRST=$LENGTH(RMPRST)
- SET LRMPRAD1=$LENGTH($EXTRACT(RMPRAD1,1,35))
- +18 SET SPACE=""
- SET $PIECE(SPACE," ",40-LRMPRAD1)=""
- +19 SET ^TMP($JOB,"RMPRPRT",CNT+6)=" "_$EXTRACT(RMPRAD1,1,35)_SPACE_$EXTRACT(RMPR("ADD"),1,39)
- +20 SET SPACE=""
- SET LRMPRAD2=$LENGTH($EXTRACT(RMPRAD2,1,35))
- SET $PIECE(SPACE," ",45-LRMPRAD1)=""
- +21 IF RMPRAD2'=""
- SET ^TMP($JOB,"RMPRPRT",CNT+7)=" "_$EXTRACT(RMPRAD2,1,35)_SPACE_RMPR("CITY")
- +22 SET SPACE=""
- SET $PIECE(SPACE," ",33-LRMPRCTY-LRMPRST)=""
- +23 IF RMPRAD2=""
- SET ^TMP($JOB,"RMPRPRT",CNT+7)=" "_RMPRCITY_","_RMPRST_" "_RMPR90IP_SPACE_RMPR("CITY")
- +24 IF RMPRAD2'=""
- SET ^TMP($JOB,"RMPRPRT",CNT+8)=" "_RMPRCITY_","_RMPRST_" "_RMPR90IP
- +25 SET K=""
- FOR
- SET K=$ORDER(^TMP($JOB,"RMPRPRT",K))
- if K=""
- QUIT
- SET CNT=K
- +26 SET ^TMP($JOB,"RMPRPRT",CNT+1)=" "_RMPRPHON_" "_$PIECE(^RMPR(669.9,RMPRSITE,0),U,4)
- +27 SET ^TMP($JOB,"RMPRPRT",CNT+2)=RMPRB
- +28 SET ^TMP($JOB,"RMPRPRT",CNT+3)="3. Veterans Name (Last, First, MI) 4. Date of Authorization"
- +29 SET SPACE=""
- SET VADM1=$LENGTH(VADM(1))
- +30 SET ^TMP($JOB,"RMPRPRT",CNT+4)=" "_VADM(1)
- SET Y=$PIECE(R664(0),U,1)
- DO DD^%DT
- +31 SET SPACE=""
- SET $PIECE(SPACE," ",40-VADM1)=""
- +32 SET ^TMP($JOB,"RMPRPRT",CNT+4)=^TMP($JOB,"RMPRPRT",CNT+4)_SPACE_Y
- +33 IF $DATA(RMPRMOR)
- SET ^TMP($JOB,"RMPRPRT",CNT+5)=RMPRB
- DO HDR1
- QUIT
- +34 SET ^TMP($JOB,"RMPRPRT",CNT+5)=RMPRB
- SET RMPRODTE=Y
- +35 SET RMPRDELD=""
- IF $DATA(R664(3))
- IF $PIECE(R664(3),U,2)]""
- SET Y=$PIECE(R664(3),U,2)
- DO DD^%DT
- SET RMPRDELD=Y
- +36 SET ^TMP($JOB,"RMPRPRT",CNT+6)="5. Veterans Address 6. Date Required"
- +37 SET SPACE=""
- SET VAPA1=$LENGTH(VAPA(1))
- SET $PIECE(SPACE," ",40-VAPA1)=""
- +38 SET ^TMP($JOB,"RMPRPRT",CNT+7)=" "_VAPA(1)_SPACE_RMPRDELD
- +39 SET SPACE=""
- SET VAPA4=$LENGTH(VAPA(4))
- SET VAPA5=$PIECE($LENGTH(VAPA(5)),U,2)
- SET VAPA6=$LENGTH(VAPA(6))
- SET $PIECE(SPACE," ",27-VAPA4-VAPA5-VAPA6)=""
- +40 IF VAPA(2)=""
- SET ^TMP($JOB,"RMPRPRT",CNT+8)=" "_VAPA(4)_","_$PIECE(VAPA(5),U,2)_" "_VAPA(6)_SPACE_$EXTRACT(RMPRB,1,40)
- +41 IF VAPA(2)=""
- SET ^TMP($JOB,"RMPRPRT",CNT+9)=" 9. Authority For Issuance CFR 17.115"
- +42 SET SPACE=""
- SET VAPA8=$LENGTH(VAPA(8))
- SET $PIECE(SPACE," ",40-VAPA8)=""
- +43 IF VAPA(2)=""
- SET ^TMP($JOB,"RMPRPRT",CNT+10)=" "_VAPA(8)_SPACE_"CHARGE MEDICAL APPROPRIATION"
- +44 SET SPACE=""
- SET VAPA2=$LENGTH(VAPA(2))
- SET $PIECE(SPACE," ",31-VAPA2)=""
- +45 IF VAPA(2)'=""
- SET ^TMP($JOB,"RMPRPRT",CNT+8)=" "_VAPA(2)_SPACE_$EXTRACT(RMPRB,1,40)
- +46 SET SPACE=""
- SET $PIECE(SPACE," ",30-VAPA4-VAPA5-VAPA6)=""
- +47 IF VAPA(2)'=""
- SET ^TMP($JOB,"RMPRPRT",CNT+9)=" "_VAPA(4)_","_$PIECE(VAPA(5),U,2)_" "_VAPA(6)_SPACE_"9. Authority For Issuance CFR 17.115"
- +48 SET SPACE=""
- SET $PIECE(SPACE," ",40-VAPA8)=""
- +49 IF VAPA(2)'=""
- SET ^TMP($JOB,"RMPRPRT",CNT+10)=" "_VAPA(8)_SPACE_"CHARGE MEDICAL APPROPRIATION"
- +50 SET ^TMP($JOB,"RMPRPRT",CNT+11)=RMPRB
- +51 ;Remove claim number print in *139 since it held SSN at times
- +52 ;Remove field 8.ID # print in *153 which held last 4 digits of SSN
- +53 SET ^TMP($JOB,"RMPRPRT",CNT+12)="7. Claim Number 8. ID #:"
- +54 SET ^TMP($JOB,"RMPRPRT",CNT+13)=RMPRB
- +55 SET ^TMP($JOB,"RMPRPRT",CNT+14)="10. Statistical Data 11. FOB Point 12. Discount 13. Delivery Time"
- +56 SET R664("E")=$ORDER(R664(1,0))
- SET CAT=$PIECE(R664(1,R664("E"),0),U,10)
- +57 SET RMPRCAT=$SELECT(CAT=1:"SC/OP",CAT=2:"SC/IP",CAT=3:"NSC/IP",CAT=4:"NSC/OP",1:"")
- +58 SET SPE=$PIECE(R664(1,R664("E"),0),U,11)
- +59 SET RMPRSCAT=$SELECT(SPE=1:"SPECIAL LEGISLATION",SPE=2:"A&A",SPE=3:"PHC",SPE=4:"ELIGIBILITY REFORM",1:"")
- +60 SET ^TMP($JOB,"RMPRPRT",CNT+15)=" "_RMPRCAT_" "_RMPRSCAT
- if +$PIECE(R664(0),U,10)
- SET RMPRFOB=$PIECE(R664(0),U,10)
- +61 SET SPACE=""
- SET LRMPRCAT=$LENGTH(RMPRCAT)
- SET LRMPSCAT=$LENGTH(RMPRSCAT)
- SET $PIECE(SPACE," ",29-LRMPRCAT-LRMPSCAT)=""
- +62 SET ^TMP($JOB,"RMPRPRT",CNT+15)=^TMP($JOB,"RMPRPRT",CNT+15)_SPACE_$SELECT($DATA(RMPRFOB):"ORIGIN",1:"DEST ")_" % "
- +63 IF $DATA(R664(2))
- SET ^TMP($JOB,"RMPRPRT",CNT+15)=^TMP($JOB,"RMPRPRT",CNT+15)_$PIECE(R664(2),U,6)
- +64 IF $DATA(R664(3))
- SET ^TMP($JOB,"RMPRPRT",CNT+15)=^TMP($JOB,"RMPRPRT",CNT+15)_" "_$PIECE(R664(3),U,3)_" Days"
- +65 SET ^TMP($JOB,"RMPRPRT",CNT+16)=RMPRB
- +66 SET ^TMP($JOB,"RMPRPRT",CNT+17)="14. Delivery To: "
- +67 if $DATA(R664(3))
- SET ^TMP($JOB,"RMPRPRT",CNT+17)=^TMP($JOB,"RMPRPRT",CNT+17)_$PIECE(R664(3),U)
- +68 SET ^TMP($JOB,"RMPRPRT",CNT+18)=" Attention: "_$PIECE(R664(3),U,4)
- +69 SET ^TMP($JOB,"RMPRPRT",CNT+19)=RMPRB
- HDR1 ;HEADER FOR 10-2421
- +1 SET K=""
- FOR
- SET K=$ORDER(^TMP($JOB,"RMPRPRT",K))
- if K=""
- QUIT
- SET CNT=K
- +2 SET ^TMP($JOB,"RMPRPRT",CNT+1)=" 15. DESCRIPTION OF ITEMS OR SERVICES AUTHORIZED"
- +3 SET ^TMP($JOB,"RMPRPRT",CNT+2)=RMPRB
- +4 SET ^TMP($JOB,"RMPRPRT",CNT+3)="ITEM NUMBER DESCRIPTION QUANTITY UNIT UNIT AMOUNT"
- +5 SET ^TMP($JOB,"RMPRPRT",CNT+4)=" ORDERED PRICE"
- +6 SET ^TMP($JOB,"RMPRPRT",CNT+5)=RMPRB
- +7 if $DATA(RMPRMOR)
- QUIT
- +8 SET K=""
- FOR
- SET K=$ORDER(^TMP($JOB,"RMPRPRT",K))
- if K=""
- QUIT
- SET CNT=K
- +9 DO ^RMPR9P22
- +10 if '$DATA(RMPRMOR1)
- DO CON^RMPR9P22
- +11 SET K=""
- FOR
- SET K=$ORDER(^TMP($JOB,"RMPRPRT",K))
- if K=""
- QUIT
- SET CNT=K
- +12 DO ^RMPR9P23
- +13 MERGE RESULTS=^TMP($JOB,"RMPRPRT")
- EX ;Common Exit Point
- +1 KILL 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
- +2 KILL 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
- DO ^%ZISC
- QUIT