RMPRPAT3 ;HINES-CIOFO/HNC,RVD - Detail Display Patient 10-2319 Transaction ;11/03/04
;;3.0;PROSTHETICS;**3,12,25,28,32,41,69,92,99,90,162,163,168**;Feb 09, 1996;Build 43
;
; Reference to $$SINFO^ICDEX supported by ICR #5747
; Reference to $$ICDDX^ICDEX supported by ICR #5747
; Reference to $$VLT^ICDEX supported by ICR #5747
;
; RVD 4/30/02 patch #69 - add ICD-9 CODE and description in the display.
; add HCPCS and Short Description.
; AAC 08/03/04 Patch 92 - Code Set Versioning (CSV)
; RGB 09/14/10 Patch 163 - Add Suspense Date to appliance line item detail
;
;expect ANS,IT(ANS)
; +IT(ANS)=ien of file 660
;expect variables from GETPAT^RMPRUTIL
; RMPRSSNE (external form of SSN)
; RMPRNAM (name of patient)
; RMPRDOB
;display detailed record
PRINT ;called from RMPRPAT2
;get 2319 transaction
;
N DIC,DIQ,DR,DA,RMPRV,RMPRDA,RV,DESCRPT
S DIC=660,DIQ="R19",DR=".01:96",DIQ(0)="EN"
S (RMPRDA,DA)=+IT(ANS)
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")=FUDGE,CHOCOLATE
;RV(440,131,.01,"E")=ORTHOTIC LAB
;
D HDR
W !,"TYPE OF FORM: ",$G(R19(660,RMPRDA,11,"E"))
W ?25,"INITIATOR: ",$G(R19(660,RMPRDA,27,"E"))
W ?55,"DATE: ",$G(R19(660,RMPRDA,1,"E"))
;historical/original item
;W !,"ITEM DESCRIPTION: ",$G(R19(660,RMPRDA,89,"E"))
W !,"DELIVER TO: ",$G(R19(660,RMPRDA,25,"E"))
W !,"TYPE TRANS: ",$G(R19(660,RMPRDA,2,"E"))
W ?30,"QTY: ",$G(R19(660,RMPRDA,5,"E"))
W:$G(R19(660,RMPRDA,29,"E")) ?40,"INVENTORY POINT: ",R19(660,RMPRDA,29,"E"),!
W ?40,"SOURCE: ",$G(R19(660,RMPRDA,12,"E"))
;vendor tracking number
I $G(R19(660,RMPRDA,11,"E"))="VISA" D
.W !,"VENDOR TRACKING: ",$G(R19(660,RMPRDA,4.2,"E"))
.W ?38,"BANK AUTHORIZATION: ",$G(R19(660,RMPRDA,4.3,"E"))
W !,"VENDOR: ",?15,$G(R19(660,RMPRDA,7,"E"))
I $D(RV) D
.W !,"VENDOR PHONE: ",?15,$G(RV(440,RMPRV,5,"E"))
.W !?15,$G(RV(440,RMPRV,1,"E"))
.W !?15,$G(RV(440,RMPRV,4.2,"E")),","
.W ?$X+3,$G(RV(440,RMPRV,4.4,"E")),?$X+5,$G(RV(440,RMPRV,4.6,"E"))
W !,"DELIVERY DATE: "
I $D(R19(660,RMPRDA,10,"E")) W R19(660,RMPRDA,10,"E")
W ?40,"SUSPENSE DATE: " I $D(R19(660,RMPRDA,8.1,"E")) W R19(660,RMPRDA,8.1,"E") ;Patch RMPR*3*163
W !
I '$P(IT(AN),U,3) D
.W "TOTAL COST: "
.I $G(R19(660,RMPRDA,14,"E"))'="" W "$"_$J(R19(660,RMPRDA,14,"E"),2)
.I $G(R19(660,RMPRDA,14,"E"))="" W $S($G(R19(660,RMPRDA,6,"E"))'="":"$"_$J(R19(660,RMPRDA,6,"E"),2),$G(R19(660,RMPRDA,48,"E"))'="":"$"_$J(R19(660,RMPRDA,48,"E"),2),1:"")
W ?30,"OBL: ",$G(R19(660,RMPRDA,23,"E"))
;
;lab data
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
.W !,"WORK ORDER: ",$G(R19(660,RMPRDA,71,"E"))
.W ?40,"RECEIVING STATION: ",$G(R19(660,RMPRDA,70,"E"))
.W !,"TECHNICIAN: ",$G(L19(664.1,RMPRLA,15,"E"))
.W !,"TOTAL LABOR HOURS: ",$G(R19(660,RMPRDA,45,"E"))
.W ?40,"TOTAL LABOR COST: ",$G(R19(660,RMPRDA,46,"E"))
.W !,"TOTAL MATERIAL COST: ",$G(R19(660,RMPRDA,47,"E"))
.W ?40,"TOTAL LAB COST: ",$G(R19(660,RMPRDA,48,"E"))
.W !,"COMPLETION DATE: ",$G(R19(660,RMPRDA,50,"E"))
.W ?40,"LAB REMARKS: ",$G(R19(660,RMPRDA,51,"E"))
W !,"REMARKS: ",?15,$G(R19(660,RMPRDA,16,"E"))
I $G(R19(660,RMPRDA,17.5,"E")) W ?40,"RETURN STATUS: ",R19(660,RMPRDA,17.5,"E")
;
;historical data
I $G(R19(660,RMPRDA,15,"E"))["*" D
.;include records that have been merged
.W !!,"HISTORICAL DATA",!
.Q:'$D(R19(660,RMPRDA,89))
.W !,?15,"ITEM: ",$G(R19(660,RMPRDA,89,"E"))
.W !,?15,"STATION: ",$G(R19(660,RMPRDA,90,"E"))
.W !,?15,"VENDOR: ",$G(R19(660,RMPRDA,91,"E"))," PHONE: ",$G(R19(660,RMPRDA,92,"E"))
.W !,?23,$G(R19(660,RMPRDA,93,"E")),!,?23,$G(R19(660,RMPRDA,94,"E"))
.W " ",$G(R19(660,RMPRDA,95,"E"))," ",$G(R19(660,RMPRDA,96,"E"))
;put in lab display here fields 45,46,47,48 and 51
;lab amis
I $G(R19(660,RMPRDA,73,"E")) D
.W ?40,"ORTHOTICS LAB CODE: "
.W $S($D(R19(660,RMPRDA,74,"E")):R19(660,RMPRDA,74,"E"),$D(R19(660,RMPRDA,75,"E")):R19(660,RMPRDA,75,"E"),1:"")
.W !?40,"RESTORATIONS LAB CODE: "
.W $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
W !,"DISABILITY SERVED: ",$G(R19(660,RMPRDA,62,"E"))
;appliance/item information
;historical/original item
W !,"ITEM DESCRIPTION: ",$G(R19(660,RMPRDA,89,"E"))
;check for item description changes
I $G(R19(660,RMPRDA,89,"E"))'=$G(R19(660,RMPRDA,4,"E")) W !,"*** See Above For Original Item Description ***"
W !,"APPLIANCE: ",$G(R19(660,RMPRDA,4,"E"))
W !,"CONTRACT #: ",$G(R19(660,RMPRDA,38.7,"E"))
W !,"EXCLUDED/WAIVER: ",$G(R19(660,RMPRDA,38.1,"E"))
W !,"PSAS HCPCS: ",$G(R19(660,RMPRDA,4.5,"E"))
I $P($G(^RMPR(660,RMPRDA,1)),U,4) W ?22,$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
; AAC - 08/03/04
; Changes for ICD-10 Class I Remediation Project
;
N RMPRACS,RMPRACSI,RMPRCNT,RMPRDAT,RMPRDATA,RMPRERR,RMPRICD,RMPRSICD
N RMPRPROD,RMPRTOR,RMPRTXT1
S (RMPRACS,RMPRACSI,RMPRDAT,RMPRDATA,RMPRICD,RMPRSICD)=""
S (RMPRPROD,RMPRTOR,RMPRTXT1)=""
S RMPRERR=0
S RMPRDAT=$P($G(^RMPR(660,RMPRDA,0)),U,1)
; Determine Active Coding System based on Date of Interest
S RMPRACS=$$SINFO^ICDEX("DIAG",RMPRDAT) ; Supported by ICR 5747
S RMPRACSI=$P(RMPRACS,U,1)
S RMPRACS=$P(RMPRACS,U,2)
S RMPRACS=$S(RMPRACS="ICD-9-CM":"ICD-9 ",RMPRACS="ICD-10-CM":"ICD-10 ",1:"ICD: ")
;
; Load Suspense data
S RMPRDATA=$G(^RMPR(660,RMPRDA,10))
I RMPRDATA'="" D
.S RMPRTOR=$P(RMPRDATA,U,5) ; TYPE OF REQUEST #8.5
.S RMPRPROD=$P(RMPRDATA,U,7) ; PROVISIONAL DIAGNOSIS #8.7
.S RMPRSICD=$P(RMPRDATA,U,8) ; SUSPENSE ICD #8.8
;
; If SUSPENSE ICD existed, retrieve data
I RMPRSICD'="" D
.; Use new API to return ICD Data
.S RMPRICD=$$ICDDX^ICDEX(RMPRSICD,RMPRDAT,RMPRACSI,"I") ; Supported by ICR 5747
.S RMPRERR=$P(RMPRICD,U,1)
.; Update error message to display either ICD-9 or ICD-10 based on Date Of Interest
.I RMPRERR<0 W !,RMPRACS_"Message: "_$P(RMPRICD,U,2) Q
.; Retrieve full ICD Description
.S RMPRTXT(2)=$$VLT^ICDEX(80,+RMPRICD,RMPRDAT) ; Supported by ICR 5747
;
; Check for Manual Suspense and adjust line label if needed
S RMPRTXT(1)=$S(RMPRTOR="MANUAL"&(RMPRSICD=""):"MANUAL SUSPENSE: ",1:RMPRACS_"CODE: ")
;
I +$G(RMPRSICD) D
.S RMPRTXT(1)=RMPRTXT(1)_$P(RMPRICD,U,2)_" "
.;
.; Process SUSPENSE ICD
.I $P(RMPRICD,U,10)'>0 D
..S Y=$P(RMPRICD,U,12) ; Inactive Date
..D DD^%DT
..S RMPRTXT(3)=" ** Inactive ** Date: "_Y
.;
.; Parse ICD data into 80 char array
.D PARSE^RMPOPED(.RMPRTXT)
;
; Loop to display ICD and Suspense info
F RMPRCNT=1:1 Q:'$D(RMPRTXT(RMPRCNT)) W !,RMPRTXT(RMPRCNT)
K RMPRTXT
;
; End of Patch 92 & ICD-10 mods
;
W !,"CPT MODIFIER: ",$G(R19(660,RMPRDA,4.7,"E"))
;set description and modify for SHIPPING CHARGE; patch RMPR*3.0*162
S DESCRPT=$G(R19(660,RMPRDA,24,"E")) S:$P(^RMPR(660,RMPRDA,0),U,17) DESCRPT="SHIPPING CHARGE"
W !,"DESCRIPTION: ",DESCRPT
W !,"EXTENDED DESCRIPTION: ",!
I $D(R19(660,RMPRDA,28)) D G:$D(DUOUT)!$D(DTOUT) EX1
.N R28
.;command part of new standards
.MERGE R28=R19(660,RMPRDA,28)
.I $P($G(^RMPR(660,RMPRDA,"DES",0)),U,3)>1 N DIR S DIR(0)="E" D ^DIR Q:$D(DUOUT)!$D(DTOUT) D HDR W !,"EXTENDED DESCRIPTION: ",!
.D EN^DDIOL(.R28)
;NPPD key items consolidated, example L5300 limb order
I $P(IT(AN),U,3) W !!,"*** Return For DETAIL REPORT ***" N DIR S DIR(0)="E" D ^DIR G:$D(DUOUT)!$D(DTOUT) EX1 W @IOF D HDR,^RMPRPAT7
;display work order if it is a 2529-3 form
;must pass ien to file 664.1 NOT 664.2
I $G(R19(660,RMPRDA,72,"I"))'="" D G EX1
.S DIR(0)="E" D ^DIR Q:$D(DTOUT)!$D(DUOUT)
.S RMPRBCK=RMPRDA
.N DIC
.S RMPRDA=R19(660,RMPRBCK,72,"I")
.D DISP^RMPR293(RMPRDA)
.S RMPRDA=RMPRBCK K RMPRBCK
;return from work order
G EXIT
;
HDR ;display heading
W @IOF,RMPRNAM,?30," SSN: "
W $E(RMPRSSN,1,3)_"-"_$E(RMPRSSN,4,5)_"-"_$E(RMPRSSN,6,10),?50
W $G(R19(660,RMPRDA,8,"E")),?70,"DOB: "
W $S(RMPRDOB:$E(RMPRDOB,4,5)_"-"_$E(RMPRDOB,6,7)_"-"_(1700+$E(RMPRDOB,1,3)),1:"Unknown")
W !?20,"APPLIANCE/REPAIR LINE ITEM DETAIL ",?70,"<4-",ANS,">",!
Q
EXIT ;common exit point
I $Y>(IOSL-4) F W ! Q:$Y>(IOSL-3)
N DIR S DIR(0)="E" D ^DIR
;duout,dtout is evaluated in dis+1^rmprpat2
EX1 ;back out through that point to clean up
K R19,RV,RMPRICD,RMPRICD,MSGICD,RMPRERR,Y W @IOF
Q
;end
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPAT3 8959 printed Apr 09, 2024@21:37:37 Page 2
RMPRPAT3 ;HINES-CIOFO/HNC,RVD - Detail Display Patient 10-2319 Transaction ;11/03/04
+1 ;;3.0;PROSTHETICS;**3,12,25,28,32,41,69,92,99,90,162,163,168**;Feb 09, 1996;Build 43
+2 ;
+3 ; Reference to $$SINFO^ICDEX supported by ICR #5747
+4 ; Reference to $$ICDDX^ICDEX supported by ICR #5747
+5 ; Reference to $$VLT^ICDEX supported by ICR #5747
+6 ;
+7 ; RVD 4/30/02 patch #69 - add ICD-9 CODE and description in the display.
+8 ; add HCPCS and Short Description.
+9 ; AAC 08/03/04 Patch 92 - Code Set Versioning (CSV)
+10 ; RGB 09/14/10 Patch 163 - Add Suspense Date to appliance line item detail
+11 ;
+12 ;expect ANS,IT(ANS)
+13 ; +IT(ANS)=ien of file 660
+14 ;expect variables from GETPAT^RMPRUTIL
+15 ; RMPRSSNE (external form of SSN)
+16 ; RMPRNAM (name of patient)
+17 ; RMPRDOB
+18 ;display detailed record
PRINT ;called from RMPRPAT2
+1 ;get 2319 transaction
+2 ;
+3 NEW DIC,DIQ,DR,DA,RMPRV,RMPRDA,RV,DESCRPT
+4 SET DIC=660
SET DIQ="R19"
SET DR=".01:96"
SET DIQ(0)="EN"
+5 SET (RMPRDA,DA)=+IT(ANS)
+6 DO EN^DIQ1
+7 SET DIQ="R19"
SET DR=72
SET DIQ(0)="I"
DO EN^DIQ1
+8 ;get vendor info
+9 SET DA=$PIECE(^RMPR(660,RMPRDA,0),U,9)
+10 IF DA
Begin DoDot:1
+11 SET DIC=440
SET DIQ="RV"
SET DR=".01:6"
SET DIQ(0)="EN"
+12 SET (RMPRV,DA)=$PIECE(^RMPR(660,RMPRDA,0),U,9)
+13 DO EN^DIQ1
End DoDot:1
+14 ;
+15 ;array defined for record in following format:
+16 ;R19(filenumber,ien,field,E)=external form of data
+17 ;RV(filenumber,ien,field,E)=external form of data
+18 ;example:
+19 ;R19(660,100,.01,"E")=APR 27, 1995
+20 ;R19(660,100,.02,"E")=FUDGE,CHOCOLATE
+21 ;RV(440,131,.01,"E")=ORTHOTIC LAB
+22 ;
+23 DO HDR
+24 WRITE !,"TYPE OF FORM: ",$GET(R19(660,RMPRDA,11,"E"))
+25 WRITE ?25,"INITIATOR: ",$GET(R19(660,RMPRDA,27,"E"))
+26 WRITE ?55,"DATE: ",$GET(R19(660,RMPRDA,1,"E"))
+27 ;historical/original item
+28 ;W !,"ITEM DESCRIPTION: ",$G(R19(660,RMPRDA,89,"E"))
+29 WRITE !,"DELIVER TO: ",$GET(R19(660,RMPRDA,25,"E"))
+30 WRITE !,"TYPE TRANS: ",$GET(R19(660,RMPRDA,2,"E"))
+31 WRITE ?30,"QTY: ",$GET(R19(660,RMPRDA,5,"E"))
+32 if $GET(R19(660,RMPRDA,29,"E"))
WRITE ?40,"INVENTORY POINT: ",R19(660,RMPRDA,29,"E"),!
+33 WRITE ?40,"SOURCE: ",$GET(R19(660,RMPRDA,12,"E"))
+34 ;vendor tracking number
+35 IF $GET(R19(660,RMPRDA,11,"E"))="VISA"
Begin DoDot:1
+36 WRITE !,"VENDOR TRACKING: ",$GET(R19(660,RMPRDA,4.2,"E"))
+37 WRITE ?38,"BANK AUTHORIZATION: ",$GET(R19(660,RMPRDA,4.3,"E"))
End DoDot:1
+38 WRITE !,"VENDOR: ",?15,$GET(R19(660,RMPRDA,7,"E"))
+39 IF $DATA(RV)
Begin DoDot:1
+40 WRITE !,"VENDOR PHONE: ",?15,$GET(RV(440,RMPRV,5,"E"))
+41 WRITE !?15,$GET(RV(440,RMPRV,1,"E"))
+42 WRITE !?15,$GET(RV(440,RMPRV,4.2,"E")),","
+43 WRITE ?$X+3,$GET(RV(440,RMPRV,4.4,"E")),?$X+5,$GET(RV(440,RMPRV,4.6,"E"))
End DoDot:1
+44 WRITE !,"DELIVERY DATE: "
+45 IF $DATA(R19(660,RMPRDA,10,"E"))
WRITE R19(660,RMPRDA,10,"E")
+46 ;Patch RMPR*3*163
WRITE ?40,"SUSPENSE DATE: "
IF $DATA(R19(660,RMPRDA,8.1,"E"))
WRITE R19(660,RMPRDA,8.1,"E")
+47 WRITE !
+48 IF '$PIECE(IT(AN),U,3)
Begin DoDot:1
+49 WRITE "TOTAL COST: "
+50 IF $GET(R19(660,RMPRDA,14,"E"))'=""
WRITE "$"_$JUSTIFY(R19(660,RMPRDA,14,"E"),2)
+51 IF $GET(R19(660,RMPRDA,14,"E"))=""
WRITE $SELECT($GET(R19(660,RMPRDA,6,"E"))'="":"$"_$JUSTIFY(R19(660,RMPRDA,6,"E"),2),$GET(R19(660,RMPRDA,48,"E"))'="":"$"_$JUSTIFY(R19(660,RMPRDA,48,"E"),2),1:"")
End DoDot:1
+52 WRITE ?30,"OBL: ",$GET(R19(660,RMPRDA,23,"E"))
+53 ;
+54 ;lab data
+55 IF $DATA(^RMPR(660,RMPRDA,"LB"))
Begin DoDot:1
+56 NEW DIC,DIQ,DR,L19,DA
+57 SET (DA,RMPRLA)=$PIECE(^RMPR(660,RMPRDA,"LB"),U,10)
+58 if DA=""
QUIT
+59 SET DIC=664.1
SET DIQ="L19"
SET DR="15"
SET DIQ(0)="E"
+60 DO EN^DIQ1
+61 WRITE !,"WORK ORDER: ",$GET(R19(660,RMPRDA,71,"E"))
+62 WRITE ?40,"RECEIVING STATION: ",$GET(R19(660,RMPRDA,70,"E"))
+63 WRITE !,"TECHNICIAN: ",$GET(L19(664.1,RMPRLA,15,"E"))
+64 WRITE !,"TOTAL LABOR HOURS: ",$GET(R19(660,RMPRDA,45,"E"))
+65 WRITE ?40,"TOTAL LABOR COST: ",$GET(R19(660,RMPRDA,46,"E"))
+66 WRITE !,"TOTAL MATERIAL COST: ",$GET(R19(660,RMPRDA,47,"E"))
+67 WRITE ?40,"TOTAL LAB COST: ",$GET(R19(660,RMPRDA,48,"E"))
+68 WRITE !,"COMPLETION DATE: ",$GET(R19(660,RMPRDA,50,"E"))
+69 WRITE ?40,"LAB REMARKS: ",$GET(R19(660,RMPRDA,51,"E"))
End DoDot:1
+70 WRITE !,"REMARKS: ",?15,$GET(R19(660,RMPRDA,16,"E"))
+71 IF $GET(R19(660,RMPRDA,17.5,"E"))
WRITE ?40,"RETURN STATUS: ",R19(660,RMPRDA,17.5,"E")
+72 ;
+73 ;historical data
+74 IF $GET(R19(660,RMPRDA,15,"E"))["*"
Begin DoDot:1
+75 ;include records that have been merged
+76 WRITE !!,"HISTORICAL DATA",!
+77 if '$DATA(R19(660,RMPRDA,89))
QUIT
+78 WRITE !,?15,"ITEM: ",$GET(R19(660,RMPRDA,89,"E"))
+79 WRITE !,?15,"STATION: ",$GET(R19(660,RMPRDA,90,"E"))
+80 WRITE !,?15,"VENDOR: ",$GET(R19(660,RMPRDA,91,"E"))," PHONE: ",$GET(R19(660,RMPRDA,92,"E"))
+81 WRITE !,?23,$GET(R19(660,RMPRDA,93,"E")),!,?23,$GET(R19(660,RMPRDA,94,"E"))
+82 WRITE " ",$GET(R19(660,RMPRDA,95,"E"))," ",$GET(R19(660,RMPRDA,96,"E"))
End DoDot:1
+83 ;put in lab display here fields 45,46,47,48 and 51
+84 ;lab amis
+85 IF $GET(R19(660,RMPRDA,73,"E"))
Begin DoDot:1
+86 WRITE ?40,"ORTHOTICS LAB CODE: "
+87 WRITE $SELECT($DATA(R19(660,RMPRDA,74,"E")):R19(660,RMPRDA,74,"E"),$DATA(R19(660,RMPRDA,75,"E")):R19(660,RMPRDA,75,"E"),1:"")
+88 WRITE !?40,"RESTORATIONS LAB CODE: "
+89 WRITE $SELECT($DATA(R19(660,RMPRDA,76,"E")):R19(660,RMPRDA,76,"E"),$DATA(R19(660,RMPRDA,77,"E")):R19(660,RMPRDA,77,"E"),1:"")
End DoDot:1
+90 ;purchasing and issue from stock amis
+91 WRITE !,"DISABILITY SERVED: ",$GET(R19(660,RMPRDA,62,"E"))
+92 ;appliance/item information
+93 ;historical/original item
+94 WRITE !,"ITEM DESCRIPTION: ",$GET(R19(660,RMPRDA,89,"E"))
+95 ;check for item description changes
+96 IF $GET(R19(660,RMPRDA,89,"E"))'=$GET(R19(660,RMPRDA,4,"E"))
WRITE !,"*** See Above For Original Item Description ***"
+97 WRITE !,"APPLIANCE: ",$GET(R19(660,RMPRDA,4,"E"))
+98 WRITE !,"CONTRACT #: ",$GET(R19(660,RMPRDA,38.7,"E"))
+99 WRITE !,"EXCLUDED/WAIVER: ",$GET(R19(660,RMPRDA,38.1,"E"))
+100 WRITE !,"PSAS HCPCS: ",$GET(R19(660,RMPRDA,4.5,"E"))
+101 IF $PIECE($GET(^RMPR(660,RMPRDA,1)),U,4)
WRITE ?22,$PIECE($GET(^RMPR(661.1,$PIECE(^RMPR(660,RMPRDA,1),U,4),0)),U,2)
+102 ; added by #69
+103 ;
+104 ; PATCH 92 - Code Set Versioning (CSV) changes below
+105 ; AAC - 08/03/04
+106 ; Changes for ICD-10 Class I Remediation Project
+107 ;
+108 NEW RMPRACS,RMPRACSI,RMPRCNT,RMPRDAT,RMPRDATA,RMPRERR,RMPRICD,RMPRSICD
+109 NEW RMPRPROD,RMPRTOR,RMPRTXT1
+110 SET (RMPRACS,RMPRACSI,RMPRDAT,RMPRDATA,RMPRICD,RMPRSICD)=""
+111 SET (RMPRPROD,RMPRTOR,RMPRTXT1)=""
+112 SET RMPRERR=0
+113 SET RMPRDAT=$PIECE($GET(^RMPR(660,RMPRDA,0)),U,1)
+114 ; Determine Active Coding System based on Date of Interest
+115 ; Supported by ICR 5747
SET RMPRACS=$$SINFO^ICDEX("DIAG",RMPRDAT)
+116 SET RMPRACSI=$PIECE(RMPRACS,U,1)
+117 SET RMPRACS=$PIECE(RMPRACS,U,2)
+118 SET RMPRACS=$SELECT(RMPRACS="ICD-9-CM":"ICD-9 ",RMPRACS="ICD-10-CM":"ICD-10 ",1:"ICD: ")
+119 ;
+120 ; Load Suspense data
+121 SET RMPRDATA=$GET(^RMPR(660,RMPRDA,10))
+122 IF RMPRDATA'=""
Begin DoDot:1
+123 ; TYPE OF REQUEST #8.5
SET RMPRTOR=$PIECE(RMPRDATA,U,5)
+124 ; PROVISIONAL DIAGNOSIS #8.7
SET RMPRPROD=$PIECE(RMPRDATA,U,7)
+125 ; SUSPENSE ICD #8.8
SET RMPRSICD=$PIECE(RMPRDATA,U,8)
End DoDot:1
+126 ;
+127 ; If SUSPENSE ICD existed, retrieve data
+128 IF RMPRSICD'=""
Begin DoDot:1
+129 ; Use new API to return ICD Data
+130 ; Supported by ICR 5747
SET RMPRICD=$$ICDDX^ICDEX(RMPRSICD,RMPRDAT,RMPRACSI,"I")
+131 SET RMPRERR=$PIECE(RMPRICD,U,1)
+132 ; Update error message to display either ICD-9 or ICD-10 based on Date Of Interest
+133 IF RMPRERR<0
WRITE !,RMPRACS_"Message: "_$PIECE(RMPRICD,U,2)
QUIT
+134 ; Retrieve full ICD Description
+135 ; Supported by ICR 5747
SET RMPRTXT(2)=$$VLT^ICDEX(80,+RMPRICD,RMPRDAT)
End DoDot:1
+136 ;
+137 ; Check for Manual Suspense and adjust line label if needed
+138 SET RMPRTXT(1)=$SELECT(RMPRTOR="MANUAL"&(RMPRSICD=""):"MANUAL SUSPENSE: ",1:RMPRACS_"CODE: ")
+139 ;
+140 IF +$GET(RMPRSICD)
Begin DoDot:1
+141 SET RMPRTXT(1)=RMPRTXT(1)_$PIECE(RMPRICD,U,2)_" "
+142 ;
+143 ; Process SUSPENSE ICD
+144 IF $PIECE(RMPRICD,U,10)'>0
Begin DoDot:2
+145 ; Inactive Date
SET Y=$PIECE(RMPRICD,U,12)
+146 DO DD^%DT
+147 SET RMPRTXT(3)=" ** Inactive ** Date: "_Y
End DoDot:2
+148 ;
+149 ; Parse ICD data into 80 char array
+150 DO PARSE^RMPOPED(.RMPRTXT)
End DoDot:1
+151 ;
+152 ; Loop to display ICD and Suspense info
+153 FOR RMPRCNT=1:1
if '$DATA(RMPRTXT(RMPRCNT))
QUIT
WRITE !,RMPRTXT(RMPRCNT)
+154 KILL RMPRTXT
+155 ;
+156 ; End of Patch 92 & ICD-10 mods
+157 ;
+158 WRITE !,"CPT MODIFIER: ",$GET(R19(660,RMPRDA,4.7,"E"))
+159 ;set description and modify for SHIPPING CHARGE; patch RMPR*3.0*162
+160 SET DESCRPT=$GET(R19(660,RMPRDA,24,"E"))
if $PIECE(^RMPR(660,RMPRDA,0),U,17)
SET DESCRPT="SHIPPING CHARGE"
+161 WRITE !,"DESCRIPTION: ",DESCRPT
+162 WRITE !,"EXTENDED DESCRIPTION: ",!
+163 IF $DATA(R19(660,RMPRDA,28))
Begin DoDot:1
+164 NEW R28
+165 ;command part of new standards
+166 MERGE R28=R19(660,RMPRDA,28)
+167 IF $PIECE($GET(^RMPR(660,RMPRDA,"DES",0)),U,3)>1
NEW DIR
SET DIR(0)="E"
DO ^DIR
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
DO HDR
WRITE !,"EXTENDED DESCRIPTION: ",!
+168 DO EN^DDIOL(.R28)
End DoDot:1
if $DATA(DUOUT)!$DATA(DTOUT)
GOTO EX1
+169 ;NPPD key items consolidated, example L5300 limb order
+170 IF $PIECE(IT(AN),U,3)
WRITE !!,"*** Return For DETAIL REPORT ***"
NEW DIR
SET DIR(0)="E"
DO ^DIR
if $DATA(DUOUT)!$DATA(DTOUT)
GOTO EX1
WRITE @IOF
DO HDR
DO ^RMPRPAT7
+171 ;display work order if it is a 2529-3 form
+172 ;must pass ien to file 664.1 NOT 664.2
+173 IF $GET(R19(660,RMPRDA,72,"I"))'=""
Begin DoDot:1
+174 SET DIR(0)="E"
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+175 SET RMPRBCK=RMPRDA
+176 NEW DIC
+177 SET RMPRDA=R19(660,RMPRBCK,72,"I")
+178 DO DISP^RMPR293(RMPRDA)
+179 SET RMPRDA=RMPRBCK
KILL RMPRBCK
End DoDot:1
GOTO EX1
+180 ;return from work order
+181 GOTO EXIT
+182 ;
HDR ;display heading
+1 WRITE @IOF,RMPRNAM,?30," SSN: "
+2 WRITE $EXTRACT(RMPRSSN,1,3)_"-"_$EXTRACT(RMPRSSN,4,5)_"-"_$EXTRACT(RMPRSSN,6,10),?50
+3 WRITE $GET(R19(660,RMPRDA,8,"E")),?70,"DOB: "
+4 WRITE $SELECT(RMPRDOB:$EXTRACT(RMPRDOB,4,5)_"-"_$EXTRACT(RMPRDOB,6,7)_"-"_(1700+$EXTRACT(RMPRDOB,1,3)),1:"Unknown")
+5 WRITE !?20,"APPLIANCE/REPAIR LINE ITEM DETAIL ",?70,"<4-",ANS,">",!
+6 QUIT
EXIT ;common exit point
+1 IF $Y>(IOSL-4)
FOR
WRITE !
if $Y>(IOSL-3)
QUIT
+2 NEW DIR
SET DIR(0)="E"
DO ^DIR
+3 ;duout,dtout is evaluated in dis+1^rmprpat2
EX1 ;back out through that point to clean up
+1 KILL R19,RV,RMPRICD,RMPRICD,MSGICD,RMPRERR,Y
WRITE @IOF
+2 QUIT
+3 ;end
