RMPR29RG ;HIOFO/SPS-OWL WINDOWS PRINTER [ 12/01/05  5:39 AM ]
 ;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25
 ;get basic info, system variables
 ;WINDOW FAX/PRINT 2529-3 PASS RMPRA
 ;REQUIRED VARIABLES: RMPRDA - ENTRY NUMBER IN FILE 664.1
 ;                    RMPRSITE - SITE OFSTATION PROCESSING 2529-3
 ;                    RMPRPTR - "WINDOWS"
IN(RMPRA,RMPRSITE,RMPRPTR) ;
 ;TEST ENTRY
 D IN2
 Q
 K CNT,I,K,L,LCN,LNM,LSSN,LSTN,R643,RDO,RDI,RHDA,RI,RIDA,RIDES,RMPR,RMPR0
 K RMPR21,RMPRAOF,RMPRCDT,RMPRCSZ,RMPRD,RMPRDA,RMPREXT,RMPRINM,RMPRINSN
 K RMPRL,RMPRODT,RMPRRDT,RMPRROF,RMPRS,RMPRSOP,RMPRSTN,RMPGIP,RPHCPC
 K RD0,RD1,RPGIP,RPSAITEM,RPSALOC,SPACE,VA,VADM,VAEL,VAPA
PRT(RESULTS,RMPRA,RMPRSITE,RMPRPTR) ;GUI ENTRY
IN2 I RMPRPTR'="WINDOWS" S RMPRDA=RMPRA G PRT^RMPR29R
 K ^TMP($J,"RMPRT"),RESULTS
 S DIC=4,DIC(0)="QZN",X=$P(^RMPR(664.1,RMPRA,0),U,15)
 D ^DIC G:+Y'>0 EXIT
 N RC
 S RMPRINS=+Y,RC=0,RMPRINSN=$P(^DIC(4,RMPRINS,99),U)
 S RMPRST=$S($D(^DIC(5,+$P(Y(0),U,2),0)):$P(^(0),U),1:"")
 S (RMPRAD(1),RMPRAD(2),RMPRCT,RMPR9P)=""
 I $D(^DIC(4,RMPRINS,1)) S RMPRAD(1)=$P(^(1),U,1),RMPRAD(2)=$P(^(1),U,2),RMPRCT=$P(^(1),U,3),RMPR9P=$P(^(1),U,4)
 S DFN=$P(^RMPR(664.1,RMPRA,0),U,2) D ALL^VADPT
 ;
 I $P(^RMPR(664.1,RMPRA,0),U,11)="N" N RMPRFCTR D
 .;national footwear center address in RMPRFCTR array used in print
 .;template RMPR 25293
 .S RMPRFCTR(1)="179TH ST & LINDEN BLVD."
 .S RMPRFCTR(2)="ST. ALBANS, NY 11425"
 ;
 S RMPR0=^RMPR(664.1,RMPRA,0)
 S RMPRRDT=$$EXTERNAL^DILFD(664.1,17,,$P(RMPR0,U,18))
 S RMPRCDT=$$EXTERNAL^DILFD(664.1,23,,$P(RMPR0,U,26))
 S RMPRROF=$$EXTERNAL^DILFD(664.1,13,,$P(RMPR0,U,5))
 S RMPRAOF=$$EXTERNAL^DILFD(664.1,14,,$P(RMPR0,U,7))
 S RMPRODT=$$EXTERNAL^DILFD(664.1,.01,,$P(RMPR0,U,1))
 S (RMPRL,RMPRD,RMPRS)="",$P(RMPRL,"_",81)="",$P(RMPRD,"-",81)=""
 S ^TMP($J,"RMPRT",0)="           REQUEST AND RECEIPT FOR PROSTHETIC APPLIANCES OR SERVICES           "
 S ^TMP($J,"RMPRT",1)=RMPRL
 S ^TMP($J,"RMPRT",2)="                                   SECTION I"
 S ^TMP($J,"RMPRT",3)=RMPRD
 S RMPRSOP=$$EXTERNAL^DILFD(664.1,2,,$P(RMPR0,U,11))
 S ^TMP($J,"RMPRT",4)="TO: | "_RMPRSOP
 S L=$L(RMPRSOP),L=L+38,$P(RMPRS," ",80-L)=""
 S (L,RMPRS)="",L=$L(RMPRSOP),L=L+6,$P(RMPRS," ",(45-L))=""
 S ^TMP($J,"RMPRT",4)=^TMP($J,"RMPRT",4)_RMPRS_"1. VETERANS NAME (LAST,FIRST,M.I.)"
 S ^TMP($J,"RMPRT",5)="      "_$$EXTERNAL^DILFD(664.1,.11,,$P(RMPR0,U,15))
 S (L,RMPRS)="",L=$L($$EXTERNAL^DILFD(664.1,.11,,$P(RMPR0,U,15))),L=L+6,$P(RMPRS," ",(49-L))=""
 S ^TMP($J,"RMPRT",5)=^TMP($J,"RMPRT",5)_RMPRS_VADM(1)
 I RMPRAD(1)'="" S ^TMP($J,"RMPRT",6)="      "_$E(RMPRAD(1),1,30)
 I RMPRAD(2)'="" S ^TMP($J,"RMPRT",7)="      "_$E(RMPRAD(2),1,30)
 S ^TMP($J,"RMPRT",8)="      "_RMPRCT_", "_RMPRST_" "_RMPR9P
 S ^TMP($J,"RMPRT",9)=RMPRD
 S ^TMP($J,"RMPRT",10)="2. VETERANS ADDRESS             3. CLAIM NO.     4. SSN          5. STATION NO."
 S LNM=$L(VADM(1)),LCN=$L(VAEL(7)),LSSN=$L(VA("PID")),LSTN=$L(RMPRINSN)
 S (L,RMPRS)="",L=$L(VADM(1)),L=L+3,$P(RMPRS," ",(36-L))=""
 S ^TMP($J,"RMPRT",11)="   "_VADM(1)_RMPRS_VAEL(7)
 S (L,RMPRS)="",L=L+$L(VAEL(7)),$P(RMPRS," ",(17-L))=""
 S ^TMP($J,"RMPRT",11)=^TMP($J,"RMPRT",11)_RMPRS_VA("PID")_"      "_RMPRINSN
 S ^TMP($J,"RMPRT",12)="   "_VAPA(1)
 I VAPA(2)'="" S ^TMP($J,"RMPRT",13)="   "_VAPA(2)
 I VAPA(3)'="" S ^TMP($J,"RMPRT",14)="   "_VAPA(3)
 S RMPRCSZ=$P(VAPA(4),U,1)_","_$P(VAPA(5),U,2)_"  "_VAPA(6)
 S L=$L(RMPRCSZ),L=50-L,SPACE="",$P(SPACE," ",L)=""
 S (L,RMPRS)="",L=L+$L(RMPRCSZ),$P(RMPRS," ",(50-L))=""
 S K="" F  S K=$O(^TMP($J,"RMPRT",K)) Q:K=""  S CNT=K
 S ^TMP($J,"RMPRT",CNT+1)="   "_RMPRCSZ_RMPRS_"VETERANS PHONE: "_VAPA(8)
 S K="" F  S K=$O(^TMP($J,"RMPRT",K)) Q:K=""  S CNT=K
 S ^TMP($J,"RMPRT",CNT+1)=RMPRD
 S ^TMP($J,"RMPRT",CNT+2)="6. AUTHORITY FOR ISSUANCE       7. ELIGIBILITY STATUS           8. DATE REQUIRED"
 S ^TMP($J,"RMPRT",CNT+3)="   CFR 17.115                       "_$S($P(VAEL(3),U,1)=1:"SC",1:"NSC")
 ;S ^TMP($J,"RMPRT",CNT+4)="    9. DISABILITY CODE:"
 S ^TMP($J,"RMPRT",CNT+5)=RMPRD
 S ^TMP($J,"RMPRT",CNT+6)="             10.TYPES AND QUANTITIES OF APPLIANCES AND/OR SERVICES REQUESTED"
 S ^TMP($J,"RMPRT",CNT+7)=RMPRD
 S ^TMP($J,"RMPRT",CNT+8)="                                                              *UNIT     *TOTAL"
 S ^TMP($J,"RMPRT",CNT+9)="     ITEM #   NOMENCLATURE               QTY          UNIT     COST      COST"
 S ^TMP($J,"RMPRT",CNT+10)=RMPRD
 ; Item Multiple
 S K="" F  S K=$O(^TMP($J,"RMPRT",K)) Q:K=""  S CNT=K
 S RI=""
 F  S RI=$O(^RMPR(664.1,RMPRA,2,RI)) Q:RI=""  D
 .Q:'$D(^RMPR(664.1,RMPRA,2,RI,0))
 .S CNT=CNT+1
 .S RMPR21=$G(^RMPR(664.1,RMPRA,2,RI,0))
 .I RMPR21="" S RESULTS="1^No item multiple found"
 .F I=1:1:11 S RMPR21(I)=""
 .S RMPR21(1)=$P(RMPR21,U,1),RMPR21(2)=$P(RMPR21,U,2)
 .S RMPR21(3)=$$EXTERNAL^DILFD(664.16,3,,$P(RMPR21,U,3))
 .S RMPRINM=$$EXTERNAL^DILFD(664.16,.01,,$P(RMPR21,U)),RMPRINM=$E(RMPRINM,1,24)
 .S RMPR21(4)=$S($P(RMPR21,U,4)>0:$P(RMPR21,U,4),1:"0.00")
 .S RMPR21(11)=$S($P(RMPR21,U,11)>0:$P(RMPR21,U,11),1:"0.00")
 .S (L,RMPRS)="",L=L+6,L=L+$L(RMPR21(1)),$P(RMPRS," ",(15-L))=""
 .S ^TMP($J,"RMPRT",CNT)="      "_RMPR21(1)_RMPRS_RMPRINM
 .S (L,RMPRS)="",L=L+$L(RMPRINM),$P(RMPRS," ",(29-L))=""
 .S ^TMP($J,"RMPRT",CNT)=^TMP($J,"RMPRT",CNT)_RMPRS_RMPR21(2)
 .S (L,RMPRS)="",L=L+$L(RMPR21(2)),$P(RMPRS," ",(14-L))=""
 .S ^TMP($J,"RMPRT",CNT)=^TMP($J,"RMPRT",CNT)_RMPRS_RMPR21(3)
 .S (L,RMPRS)="",L=L+$L(RMPR21(3)),$P(RMPRS," ",(8-L))=""
 .S ^TMP($J,"RMPRT",CNT)=^TMP($J,"RMPRT",CNT)_RMPRS_RMPR21(4)_RMPRS_RMPR21(11)
 .S RMPREXT=0
 .F  S RMPREXT=$O(^RMPR(664.1,RMPRA,2,RI,1,RMPREXT)) Q:RMPREXT=""  D
 ..S CNT=CNT+1
 ..S ^TMP($J,"RMPRT",CNT)=^RMPR(664.1,RMPRA,2,RI,1,RMPREXT,0)
 .D HCP
 S K="" F  S K=$O(^TMP($J,"RMPRT",K)) Q:K=""  S CNT=K
 S ^TMP($J,"RMPRT",CNT+1)=RMPRD
 S ^TMP($J,"RMPRT",CNT+2)="11. PROCUREMENT SOURCE: "_RMPRSOP
 S ^TMP($J,"RMPRT",CNT+3)=RMPRD
 S ^TMP($J,"RMPRT",CNT+4)="12. SIGNATURE AND TITLE OF   13. DATE    14. SIGNATURE AND TITLE OF   15. DATE"
 S ^TMP($J,"RMPRT",CNT+5)="    REQUESTING OFFICIAL      "_RMPRRDT_"    APPROVING OFFICIAL"
 S (L,RMPRS)="",L=+$L(RMPRROF),$P(RMPRS," ",(46-L))=""
 S ^TMP($J,"RMPRT",CNT+6)="    "_RMPRROF_RMPRS_RMPRAOF
 S ^TMP($J,"RMPRT",CNT+7)=RMPRD
 S ^TMP($J,"RMPRT",CNT+8)="                             SECTION III"
 S ^TMP($J,"RMPRT",CNT+9)=RMPRL
 S ^TMP($J,"RMPRT",CNT+10)="16. ORDER NUMBER             17. DATE OF ORDER        18. DATE ITEM RECIEVED"
 S (L,RMPRS)="",L=$L($P(RMPR0,U,13)),$P(RMPRS," ",(30-L))=""
 S ^TMP($J,"RMPRT",CNT+11)="    "_$P(RMPR0,U,13)_RMPRS_RMPRODT
 S ^TMP($J,"RMPRT",CNT+12)=RMPRD
 S ^TMP($J,"RMPRT",CNT+13)="19. DATE DELIVERED                         20. SIGNATURE OF INSPECTING OFFICIAL"
 S ^TMP($J,"RMPRT",CNT+14)=""
 S ^TMP($J,"RMPRT",CNT+15)=RMPRD
 S ^TMP($J,"RMPRT",CNT+16)="21. CERTIFICATE OF RECEIPT OR DELIVERY (Check One)"
 S ^TMP($J,"RMPRT",CNT+17)=RMPRD
 S ^TMP($J,"RMPRT",CNT+18)="[ ] I certify that I have received the items listed above"
 S ^TMP($J,"RMPRT",CNT+19)="[ ] I certify that the above item(s) have been sent to"
 S ^TMP($J,"RMPRT",CNT+20)="     the Veteran or the requesting field station"
 S ^TMP($J,"RMPRT",CNT+21)=RMPRD
 S ^TMP($J,"RMPRT",CNT+22)="22. SIGNATURE OF VETERAN OR VA OFFICIAL"
 S ^TMP($J,"RMPRT",CNT+23)=""
 S ^TMP($J,"RMPRT",CNT+24)=RMPRD
 S ^TMP($J,"RMPRT",CNT+25)="23 SIGNATURE OF DESIGNATED EMPLOYEE        24. DATE       25. STATION NO."
 S RMPRSTN="" I $D(RMPR("STA")) S RMPRSTN=$P($G(^DIC(4,+RMPR("STA"),99)),U)
 S ^TMP($J,"RMPRT",CNT+26)="                                            "_RMPRCDT_"                   "_RMPRSTN
 S ^TMP($J,"RMPRT",CNT+27)=RMPRD
 S ^TMP($J,"RMPRT",CNT+28)="ADP FORM 2529-3"
 M RESULTS=^TMP($J,"RMPRT")
 G EXIT
 Q
HCP ;print HCPCS and GIP or Pros Inventory in -3.
 Q:RI'>0
 S RD0=RMPRA,RD1=RI
 Q:'$D(^RMPR(664.1,RD0,2,RD1,0))
 S R643=$G(^RMPR(664.1,RD0,2,RD1,3))
 S RPSAITEM=$P(R643,U,3),RPSALOC=$P(R643,U,4)
 S RPHCPC=$P($G(^RMPR(664.1,RD0,2,RD1,2)),U,1)
 Q:'$G(RPHCPC)
 Q:'$D(^RMPR(661.1,RPHCPC,0))
 S RPGIP=$P($G(^RMPR(664.1,RD0,2,RD1,0)),U,13)
 S ^TMP($J,"RMPRT",CNT+1)="          HCPCS: "_$P(^RMPR(661.1,RPHCPC,0),U,1)
 I $G(RPSALOC),RPSAITEM'="",$D(^RMPR(661.3,RPSALOC,0)) D
 .S RHDA=$O(^RMPR(661.3,RPSALOC,1,"B",RPHCPC,0)) Q:'$G(RHDA)
 .S RIDA=$O(^RMPR(661.3,RPSALOC,1,RHDA,1,"B",RPSAITEM,0))
 .S RIDES=$P($G(^RMPR(661.3,RPSALOC,1,RHDA,1,RIDA,0)),U,8)
 .S ^TMP($J,"RMPRT",CNT+1)=^TMP($J,"RMPRT",CNT+1)_"   RIDES"
 I $G(RPSALOC) S ^TMP($J,"RMPRT",CNT+2)="*** Pros Inventory ***    Location: "
 I $G(RPSALOC) S:$D(^RMPR(661.3,RPSALOC,0)) ^TMP($J,"RMPRT",CNT+2)=^TMP($J,"RMPRT",CNT+2)_$P(^RMPR(661.3,RPSALOC,0),U,1)
 I '$G(RPSALOC),$G(RPGIP) S ^TMP($J,"RMPRT",CNT+2)="         *** GIP ***"
 I '$G(RPSALOC),'$G(RPGIP) S ^TMP($J,"RMPRT",CNT+2)="         *** OTHER ***"
 Q
EXIT ;common exit point
 K RMPRA,RMPRSITE,RMPRPTR,RMPRINS,RMPRST,RMPRAD,DIC,DFN
 K RA,RB,RFL,RMPRCT,RMPRI,RMPRSC,RMPRWO,RMPR9P,SRC,TO,X,Y
 D KVAR^VADPT
 Q