RMPR9S4E ;HOIFO/SPS-GUI 2319 Extended Display Transaction screen 4 ;12/17/02  09:35
 ;;3.0;PROSTHETICS;**59,92,99,90,75**;Feb 09, 1996;Build 25
 ;
 ;         (IEN)=ien of file 660
 ;
 ;AAC Patch 92 08/04/04 - Code Set Versioning (CSV)
 ;Used API=ICDDX^ICDCODE to replace direct calls to global ICD9(80)
 ;
 ;
 ;display detailed record
A1(IEN) G A2
EN(RESULTS,IEN) ;Broker
A2 ;
 I +IEN'>0 S RESULTS(0)="NOTHING TO REPORT" G EXIT
 I '$D(^RMPR(660,IEN)) S RESULTS(0)="NOTHING TO REPORT" G EXIT
 N DIC,DIQ,DR,DA,RMPRV,RMPRDA,RV
 S DIC=660,DIQ="R19",DR=".01:96",DIQ(0)="EN"
 S (RMPRDA,DA)=(IEN)
 D EN^DIQ1
 S DIQ="R19",DR=72,DIQ(0)="I" D EN^DIQ1
 ;get vendor info
 S DA=$P(^RMPR(660,RMPRDA,0),U,9)
 I DA D
 .S DIC=440,DIQ="RV",DR=".01:6",DIQ(0)="EN"
 .S (RMPRV,DA)=$P(^RMPR(660,RMPRDA,0),U,9)
 .D EN^DIQ1
 ;
 ;array defined for record in following format:
 ;R19(filenumber,ien,field,E)=external form of data
 ;RV(filenumber,ien,field,E)=external form of data
 ;example:
 ;R19(660,100,.01,"E")=APR 27, 1995
 ;R19(660,100,.02,"E")=NAME,PATIENT
 ;RV(440,131,.01,"E")=ORTHOTIC LAB
 S RMPRDFN=$P(^RMPR(660,RMPRDA,0),U,2)
 S RMPRNAM=$P(^DPT(RMPRDFN,0),U),RMPRSSN=$P(^(0),U,9),RMPRDOB=$P(^(0),U,3)
 ;
 D HDR
 ; "TYPE OF FORM: ",
 S RESULTS(5)=$G(R19(660,RMPRDA,11,"E"))
 ; "INITIATOR: ",
 S RESULTS(6)=$G(R19(660,RMPRDA,27,"E"))
 ; "DATE: ",
 S RESULTS(7)=$G(R19(660,RMPRDA,1,"E"))
 ; "DELIVER TO: ",
 S RESULTS(8)=$G(R19(660,RMPRDA,25,"E"))
 ; "TYPE TRANS: ",
 S RESULTS(9)=$G(R19(660,RMPRDA,2,"E"))
 ; "QTY: ",
 S RESULTS(10)=$G(R19(660,RMPRDA,5,"E"))
 ; "INVENTORY POINT: "
 S RESULTS(11)=$G(R19(660,RMPRDA,29,"E"))
 ; "SOURCE: ",
 S RESULTS(12)=$G(R19(660,RMPRDA,12,"E"))
 ;vendor tracking number
 S (RESULTS(13),RESULTS(14))=""
 I $G(R19(660,RMPRDA,11,"E"))="VISA" D
 .; "VENDOR TRACKING: ",
 .S RESULTS(13)=$G(R19(660,RMPRDA,4.2,"E"))
 .; "BANK AUTHORIZATION: ",
 .S RESULTS(14)=$G(R19(660,RMPRDA,38.7,"E"))
 ; "VENDOR: ",
 S RESULTS(15)=$G(R19(660,RMPRDA,7,"E"))
 ; VENDOR PHONE AND ADDRESS INFO
 F I=16:1:20 S RESULTS(I)=""
 I $D(RV) D
 .; "VENDOR PHONE: and Address ",
 .S RESULTS(16)=$G(RV(440,RMPRV,5,"E"))
 .S RESULTS(17)=$G(RV(440,RMPRV,1,"E"))
 .S RESULTS(18)=$G(RV(440,RMPRV,4.2,"E"))
 .S RESULTS(19)=$G(RV(440,RMPRV,4.4,"E"))
 .S RESULTS(20)=$G(RV(440,RMPRV,4.6,"E"))
 ; "DELIVERY DATE: "
 S RESULTS(21)=$G(R19(660,RMPRDA,10,"E"))
 ; "TOTAL COST: "
 S RESULTS(22)=0.00
 I $G(R19(660,RMPRDA,14,"E"))'="" S RESULTS(22)="$"_$FN(R19(660,RMPRDA,14,"E"),"T",2)
 I $G(R19(660,RMPRDA,14,"E"))="" S RESULTS(22)=$S($G(R19(660,RMPRDA,6,"E"))'="":"$"_$FN(R19(660,RMPRDA,6,"E"),"T",2),$G(R19(660,RMPRDA,48,"E"))'="":"$"_$FN(R19(660,RMPRDA,48,"E"),"T",2),1:"")
 ; "OBL: ",
 S RESULTS(23)=$G(R19(660,RMPRDA,23,"E"))
 ;
 ;lab data
 F I=24:1:32 S RESULTS(I)=""
 I $D(^RMPR(660,RMPRDA,"LB")) D
 .N DIC,DIQ,DR,L19,DA
 .S (DA,RMPRLA)=$P(^RMPR(660,RMPRDA,"LB"),U,10)
 .Q:DA=""
 .S DIC=664.1,DIQ="L19",DR="15",DIQ(0)="E"
 .D EN^DIQ1
 .; "WORK ORDER: ",
 .S RESULTS(24)=$G(R19(660,RMPRDA,71,"E"))
 .I $P(^RMPR(660,RMPRDA,"AM"),U,2)=1 S RESULTS(24)=$G(R19(660,RMPRDA,72.5,"E"))
 .I $P(^RMPR(660,RMPRDA,"LB"),U,14)=1 S RESULTS(24)=$G(R19(660,RMPRDA,72.5,"E"))
 .; "RECEIVING STATION: ",
 .S RESULTS(25)=$G(R19(660,RMPRDA,70,"E"))
 .; "TECHNICIAN: ",
 .S RESULTS(26)=$G(L19(664.1,RMPRLA,15,"E"))
 .; "TOTAL LABOR HOURS: ",
 .S RESULTS(27)=$G(R19(660,RMPRDA,45,"E"))
 .; "TOTAL LABOR COST: ",
 .S RESULTS(28)=$G(R19(660,RMPRDA,46,"E"))
 .; "TOTAL MATERIAL COST: ",
 .S RESULTS(29)=$G(R19(660,RMPRDA,47,"E"))
 .; "TOTAL LAB COST: ",
 .S RESULTS(30)=$G(R19(660,RMPRDA,48,"E"))
 .; "COMPLETION DATE: ",
 .S RESULTS(31)=$G(R19(660,RMPRDA,50,"E"))
 .; "LAB REMARKS: ",
 .S RESULTS(32)=$G(R19(660,RMPRDA,51,"E"))
 ; "REMARKS: ",
 S RESULTS(33)=$G(R19(660,RMPRDA,16,"E"))
 ; "RETURN STATUS: ",
 S RESULTS(34)=$G(R19(660,RMPRDA,17.5,"E"))
 ;
 ; CoreFLS Data used to be/and same as historical data
 F I=35:1:42 S RESULTS(I)=""
 I $G(R19(660,RMPRDA,15,"E"))["*" D
 .;include records that have been merged
 .; "COREFLS/HISTORICAL DATA",!
 .Q:'$D(R19(660,RMPRDA,89))
 .; "ITEM: ",
 .S RESULTS(35)=$G(R19(660,RMPRDA,89,"E"))
 .; "STATION: ",
 .S RESULTS(36)=$G(R19(660,RMPRDA,90,"E"))
 .; "VENDOR: ",
 .S RESULTS(37)=$G(R19(660,RMPRDA,91,"E"))
 .; "   PHONE: ",
 .S RESULTS(38)=$G(R19(660,RMPRDA,92,"E"))
 .; " STREET
 .S RESULTS(39)=$G(R19(660,RMPRDA,93,"E"))
 .; CITY
 .S RESULTS(40)=$G(R19(660,RMPRDA,94,"E"))
 .; STATE
 .S RESULTS(41)=$G(R19(660,RMPRDA,95,"E"))
 .; ZIP
 .S RESULTS(42)=$G(R19(660,RMPRDA,96,"E"))
 ;put in lab display here fields 45,46,47,48 and 51
 ;lab amis
 F I=43:1:44 S RESULTS(I)=""
 I $G(R19(660,RMPRDA,73,"E")) D
 .; "ORTHOTICS LAB CODE: "
 .S RESULTS(43)=$S($D(R19(660,RMPRDA,74,"E")):R19(660,RMPRDA,74,"E"),$D(R19(660,RMPRDA,75,"E")):R19(660,RMPRDA,75,"E"),1:"")
 .; "RESTORATIONS LAB CODE: "
 .S RESULTS(44)=$S($D(R19(660,RMPRDA,76,"E")):R19(660,RMPRDA,76,"E"),$D(R19(660,RMPRDA,77,"E")):R19(660,RMPRDA,77,"E"),1:"")
 ;purchasing and issue from stock amis
 ; "DISABILITY SERVED: ",
 S RESULTS(45)=$G(R19(660,RMPRDA,62,"E"))
 ;appliance/item information
 ; "APPLIANCE: ",
 ;S RESULTS(46)=$G(R19(660,RMPRDA,4,"E"))
 S RESULTS(46)=$G(R19(660,RMPRDA,89,"E"))
 ; "PSAS HCPCS: ",
 S RESULTS(47)=$G(R19(660,RMPRDA,4.5,"E"))
 ; "PSAS HCPCS DESC.
 S RESULTS(48)=""
 I $P($G(^RMPR(660,RMPRDA,1)),U,4) S RESULTS(48)=$P($G(^RMPR(661.1,$P(^RMPR(660,RMPRDA,1),U,4),0)),U,2)
 ;added by #69
 ;
 ; Patch 92 - Code Set Versioning (CSV) changes below inserted afer the line above for #69
 ; AAC - 08/04/04
 ;
 S (RMPRICD,RMPRIC0,RMPRCOD,RMPRIC9,RESULTS(49))="" S RMPRERR=0
 S RMPRDAT=$G(R19(660,RMPRDA,.01,"E"))
 I $D(^RMPR(660,RMPRDA,10)) S RMPRIC9=$P(^RMPR(660,RMPRDA,10),U,8)
 I RMPRIC9'=""  D
 .S RMPRICD=$$ICDDX^ICDCODE(RMPRIC9,RMPRDAT)
 .S RMPRERR=$P(RMPRICD,U,1)
 .I RMPRERR<0 S RESULTS(49)=$P(RMPRICD,U,2)
ZZ ;
 I RMPRERR>0 S RESULTS(49)=$P(RMPRICD,U,2)_" "_$E($P(RMPRICD,U,4),1,55) I $P(RMPRICD,U,10)'>0 S RESULTS(49)=RESULTS(49)_" "_"** Inactive ** Date: " S Y=$P(RMPRICD,U,12) D DD^%DT S RESULTS(49)=RESULTS(49)_" "_Y
 ; "ICD-9 Code: ",
 ; S RESULTS(49)=RMPRICC_"    "_$E($G(^ICD9(RMPRIC9,1)),1,55)
 ;
 ; End Patch 92
 ;
 ; "CPT MODIFIER: ",
 S RESULTS(50)=$G(R19(660,RMPRDA,38.1,"E"))
 ; "DESCRIPTION: ",
 S RESULTS(51)=$G(R19(660,RMPRDA,24,"E"))
 ; ,"EXTENDED DESCRIPTION: ",!
 N R28
 I $D(R19(660,RMPRDA,28)) D
 .;command part of new standards
 .MERGE R28=R19(660,RMPRDA,28)
 S LN=0,CNT=52
 F  S LN=$O(R28(LN)) Q:LN'>0  D
 .S RESULTS(CNT)=R28(LN)
 .S CNT=CNT+1
 G EXIT
 ;
HDR ;display heading
 S RESULTS(1)=RMPRNAM
 ; " SSN: "
 S RESULTS(2)=$E(RMPRSSN,1,3)_"-"_$E(RMPRSSN,4,5)_"-"_$E(RMPRSSN,6,10)
 S RESULTS(3)=$G(R19(660,RMPRDA,8,"E"))
 ; "DOB: "
 S RESULTS(4)=$S(RMPRDOB:$E(RMPRDOB,4,5)_"-"_$E(RMPRDOB,6,7)_"-"_(1700+$E(RMPRDOB,1,3)),1:"Unknown")
 Q
EXIT ;common exit point
 I '$D(RESULTS) S RESULTS(0)="NOTHING TO REPORT"
 K R19,RV,RMPRICC,RMPRICD,RMPRIC9,RMPRCOD,RMPRDAT,RMPRERR,RMPRIC0,Y
 Q
 ;end