Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPRPAT3

RMPRPAT3.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; Reference to $$SINFO^ICDEX supported by ICR #5747
  1.  ; Reference to $$ICDDX^ICDEX supported by ICR #5747
  1.  ; Reference to $$VLT^ICDEX   supported by ICR #5747
  1.  ; 
  1.  ; RVD 4/30/02 patch #69 - add ICD-9 CODE and description in the display.
  1.  ;                         add HCPCS and Short Description.
  1.  ; AAC 08/03/04 Patch 92 - Code Set Versioning (CSV)
  1.  ; RGB 09/14/10 Patch 163 - Add Suspense Date to appliance line item detail
  1.  ;
  1.  ;expect ANS,IT(ANS)
  1.  ;          +IT(ANS)=ien of file 660
  1.  ;expect variables from GETPAT^RMPRUTIL
  1.  ;    RMPRSSNE (external form of SSN)
  1.  ;    RMPRNAM (name of patient)
  1.  ;    RMPRDOB
  1.  ;display detailed record
  1. PRINT ;called from RMPRPAT2
  1.  ;get 2319 transaction
  1.  ;
  1.  N DIC,DIQ,DR,DA,RMPRV,RMPRDA,RV,DESCRPT
  1.  S DIC=660,DIQ="R19",DR=".01:96",DIQ(0)="EN"
  1.  S (RMPRDA,DA)=+IT(ANS)
  1.  D EN^DIQ1
  1.  S DIQ="R19",DR=72,DIQ(0)="I" D EN^DIQ1
  1.  ;get vendor info
  1.  S DA=$P(^RMPR(660,RMPRDA,0),U,9)
  1.  I DA D
  1.  .S DIC=440,DIQ="RV",DR=".01:6",DIQ(0)="EN"
  1.  .S (RMPRV,DA)=$P(^RMPR(660,RMPRDA,0),U,9)
  1.  .D EN^DIQ1
  1.  ;
  1.  ;array defined for record in following format:
  1.  ;R19(filenumber,ien,field,E)=external form of data
  1.  ;RV(filenumber,ien,field,E)=external form of data
  1.  ;example:
  1.  ;R19(660,100,.01,"E")=APR 27, 1995
  1.  ;R19(660,100,.02,"E")=FUDGE,CHOCOLATE
  1.  ;RV(440,131,.01,"E")=ORTHOTIC LAB
  1.  ;
  1.  D HDR
  1.  W !,"TYPE OF FORM: ",$G(R19(660,RMPRDA,11,"E"))
  1.  W ?25,"INITIATOR: ",$G(R19(660,RMPRDA,27,"E"))
  1.  W ?55,"DATE: ",$G(R19(660,RMPRDA,1,"E"))
  1.  ;historical/original item
  1.  ;W !,"ITEM DESCRIPTION: ",$G(R19(660,RMPRDA,89,"E"))
  1.  W !,"DELIVER TO: ",$G(R19(660,RMPRDA,25,"E"))
  1.  W !,"TYPE TRANS: ",$G(R19(660,RMPRDA,2,"E"))
  1.  W ?30,"QTY: ",$G(R19(660,RMPRDA,5,"E"))
  1.  W:$G(R19(660,RMPRDA,29,"E")) ?40,"INVENTORY POINT: ",R19(660,RMPRDA,29,"E"),!
  1.  W ?40,"SOURCE: ",$G(R19(660,RMPRDA,12,"E"))
  1.  ;vendor tracking number
  1.  I $G(R19(660,RMPRDA,11,"E"))="VISA" D
  1.  .W !,"VENDOR TRACKING: ",$G(R19(660,RMPRDA,4.2,"E"))
  1.  .W ?38,"BANK AUTHORIZATION: ",$G(R19(660,RMPRDA,4.3,"E"))
  1.  W !,"VENDOR: ",?15,$G(R19(660,RMPRDA,7,"E"))
  1.  I $D(RV) D
  1.  .W !,"VENDOR PHONE: ",?15,$G(RV(440,RMPRV,5,"E"))
  1.  .W !?15,$G(RV(440,RMPRV,1,"E"))
  1.  .W !?15,$G(RV(440,RMPRV,4.2,"E")),","
  1.  .W ?$X+3,$G(RV(440,RMPRV,4.4,"E")),?$X+5,$G(RV(440,RMPRV,4.6,"E"))
  1.  W !,"DELIVERY DATE: "
  1.  I $D(R19(660,RMPRDA,10,"E")) W R19(660,RMPRDA,10,"E")
  1.  W ?40,"SUSPENSE DATE: " I $D(R19(660,RMPRDA,8.1,"E")) W R19(660,RMPRDA,8.1,"E")   ;Patch RMPR*3*163
  1.  W !
  1.  I '$P(IT(AN),U,3) D
  1.  .W "TOTAL COST: "
  1.  .I $G(R19(660,RMPRDA,14,"E"))'="" W "$"_$J(R19(660,RMPRDA,14,"E"),2)
  1.  .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:"")
  1.  W ?30,"OBL: ",$G(R19(660,RMPRDA,23,"E"))
  1.  ;
  1.  ;lab data
  1.  I $D(^RMPR(660,RMPRDA,"LB")) D
  1.  .N DIC,DIQ,DR,L19,DA
  1.  .S (DA,RMPRLA)=$P(^RMPR(660,RMPRDA,"LB"),U,10)
  1.  .Q:DA=""
  1.  .S DIC=664.1,DIQ="L19",DR="15",DIQ(0)="E"
  1.  .D EN^DIQ1
  1.  .W !,"WORK ORDER: ",$G(R19(660,RMPRDA,71,"E"))
  1.  .W ?40,"RECEIVING STATION: ",$G(R19(660,RMPRDA,70,"E"))
  1.  .W !,"TECHNICIAN: ",$G(L19(664.1,RMPRLA,15,"E"))
  1.  .W !,"TOTAL LABOR HOURS: ",$G(R19(660,RMPRDA,45,"E"))
  1.  .W ?40,"TOTAL LABOR COST: ",$G(R19(660,RMPRDA,46,"E"))
  1.  .W !,"TOTAL MATERIAL COST: ",$G(R19(660,RMPRDA,47,"E"))
  1.  .W ?40,"TOTAL LAB COST: ",$G(R19(660,RMPRDA,48,"E"))
  1.  .W !,"COMPLETION DATE: ",$G(R19(660,RMPRDA,50,"E"))
  1.  .W ?40,"LAB REMARKS: ",$G(R19(660,RMPRDA,51,"E"))
  1.  W !,"REMARKS: ",?15,$G(R19(660,RMPRDA,16,"E"))
  1.  I $G(R19(660,RMPRDA,17.5,"E")) W ?40,"RETURN STATUS: ",R19(660,RMPRDA,17.5,"E")
  1.  ;
  1.  ;historical data
  1.  I $G(R19(660,RMPRDA,15,"E"))["*" D
  1.  .;include records that have been merged
  1.  .W !!,"HISTORICAL DATA",!
  1.  .Q:'$D(R19(660,RMPRDA,89))
  1.  .W !,?15,"ITEM: ",$G(R19(660,RMPRDA,89,"E"))
  1.  .W !,?15,"STATION: ",$G(R19(660,RMPRDA,90,"E"))
  1.  .W !,?15,"VENDOR: ",$G(R19(660,RMPRDA,91,"E")),"   PHONE: ",$G(R19(660,RMPRDA,92,"E"))
  1.  .W !,?23,$G(R19(660,RMPRDA,93,"E")),!,?23,$G(R19(660,RMPRDA,94,"E"))
  1.  .W "   ",$G(R19(660,RMPRDA,95,"E")),"  ",$G(R19(660,RMPRDA,96,"E"))
  1.  ;put in lab display here fields 45,46,47,48 and 51
  1.  ;lab amis
  1.  I $G(R19(660,RMPRDA,73,"E")) D
  1.  .W ?40,"ORTHOTICS LAB CODE: "
  1.  .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:"")
  1.  .W !?40,"RESTORATIONS LAB CODE: "
  1.  .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:"")
  1.  ;purchasing and issue from stock amis
  1.  W !,"DISABILITY SERVED: ",$G(R19(660,RMPRDA,62,"E"))
  1.  ;appliance/item information
  1.  ;historical/original item
  1.  W !,"ITEM DESCRIPTION: ",$G(R19(660,RMPRDA,89,"E"))
  1.  ;check for item description changes
  1.  I $G(R19(660,RMPRDA,89,"E"))'=$G(R19(660,RMPRDA,4,"E")) W !,"*** See Above For Original Item Description ***"
  1.  W !,"APPLIANCE: ",$G(R19(660,RMPRDA,4,"E"))
  1.  W !,"CONTRACT #: ",$G(R19(660,RMPRDA,38.7,"E"))
  1.  W !,"EXCLUDED/WAIVER: ",$G(R19(660,RMPRDA,38.1,"E"))
  1.  W !,"PSAS HCPCS: ",$G(R19(660,RMPRDA,4.5,"E"))
  1.  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)
  1.  ; added by #69
  1.  ;
  1.  ; PATCH 92 - Code Set Versioning (CSV) changes below
  1.  ; AAC      - 08/03/04
  1.  ; Changes for ICD-10 Class I Remediation Project
  1.  ;
  1.  N RMPRACS,RMPRACSI,RMPRCNT,RMPRDAT,RMPRDATA,RMPRERR,RMPRICD,RMPRSICD
  1.  N RMPRPROD,RMPRTOR,RMPRTXT1
  1.  S (RMPRACS,RMPRACSI,RMPRDAT,RMPRDATA,RMPRICD,RMPRSICD)=""
  1.  S (RMPRPROD,RMPRTOR,RMPRTXT1)=""
  1.  S RMPRERR=0
  1.  S RMPRDAT=$P($G(^RMPR(660,RMPRDA,0)),U,1)
  1.  ; Determine Active Coding System based on Date of Interest
  1.  S RMPRACS=$$SINFO^ICDEX("DIAG",RMPRDAT) ; Supported by ICR 5747
  1.  S RMPRACSI=$P(RMPRACS,U,1)
  1.  S RMPRACS=$P(RMPRACS,U,2)
  1.  S RMPRACS=$S(RMPRACS="ICD-9-CM":"ICD-9 ",RMPRACS="ICD-10-CM":"ICD-10 ",1:"ICD: ")
  1.  ;
  1.  ; Load Suspense data
  1.  S RMPRDATA=$G(^RMPR(660,RMPRDA,10))
  1.  I RMPRDATA'="" D
  1.  .S RMPRTOR=$P(RMPRDATA,U,5) ; TYPE OF REQUEST #8.5
  1.  .S RMPRPROD=$P(RMPRDATA,U,7) ; PROVISIONAL DIAGNOSIS #8.7
  1.  .S RMPRSICD=$P(RMPRDATA,U,8) ; SUSPENSE ICD #8.8
  1.  ;
  1.  ; If SUSPENSE ICD existed, retrieve data
  1.  I RMPRSICD'="" D
  1.  .; Use new API to return ICD Data
  1.  .S RMPRICD=$$ICDDX^ICDEX(RMPRSICD,RMPRDAT,RMPRACSI,"I") ; Supported by ICR 5747
  1.  .S RMPRERR=$P(RMPRICD,U,1)
  1.  .; Update error message to display either ICD-9 or ICD-10 based on Date Of Interest
  1.  .I RMPRERR<0 W !,RMPRACS_"Message: "_$P(RMPRICD,U,2) Q
  1.  .; Retrieve full ICD Description
  1.  .S RMPRTXT(2)=$$VLT^ICDEX(80,+RMPRICD,RMPRDAT) ; Supported by ICR 5747
  1.  ;
  1.  ; Check for Manual Suspense and adjust line label if needed
  1.  S RMPRTXT(1)=$S(RMPRTOR="MANUAL"&(RMPRSICD=""):"MANUAL SUSPENSE: ",1:RMPRACS_"CODE: ")
  1.  ;
  1.  I +$G(RMPRSICD) D
  1.  .S RMPRTXT(1)=RMPRTXT(1)_$P(RMPRICD,U,2)_"  "
  1.  .;
  1.  .; Process SUSPENSE ICD
  1.  .I $P(RMPRICD,U,10)'>0 D
  1.  ..S Y=$P(RMPRICD,U,12) ; Inactive Date
  1.  ..D DD^%DT
  1.  ..S RMPRTXT(3)="  ** Inactive ** Date: "_Y
  1.  .;
  1.  .; Parse ICD data into 80 char array
  1.  .D PARSE^RMPOPED(.RMPRTXT)
  1.  ;
  1.  ; Loop to display ICD and Suspense info
  1.  F RMPRCNT=1:1 Q:'$D(RMPRTXT(RMPRCNT))  W !,RMPRTXT(RMPRCNT)
  1.  K RMPRTXT
  1.  ;
  1.  ; End of Patch 92 & ICD-10 mods
  1.  ; 
  1.  W !,"CPT MODIFIER: ",$G(R19(660,RMPRDA,4.7,"E"))
  1.  ;set description and modify for SHIPPING CHARGE; patch RMPR*3.0*162
  1.  S DESCRPT=$G(R19(660,RMPRDA,24,"E")) S:$P(^RMPR(660,RMPRDA,0),U,17) DESCRPT="SHIPPING CHARGE"
  1.  W !,"DESCRIPTION: ",DESCRPT
  1.  W !,"EXTENDED DESCRIPTION: ",!
  1.  I $D(R19(660,RMPRDA,28)) D  G:$D(DUOUT)!$D(DTOUT) EX1
  1.  .N R28
  1.  .;command part of new standards
  1.  .MERGE R28=R19(660,RMPRDA,28)
  1.  .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: ",!
  1.  .D EN^DDIOL(.R28)
  1.  ;NPPD key items consolidated, example L5300 limb order
  1.  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
  1.  ;display work order if it is a 2529-3 form
  1.  ;must pass ien to file 664.1 NOT 664.2
  1.  I $G(R19(660,RMPRDA,72,"I"))'="" D  G EX1
  1.  .S DIR(0)="E" D ^DIR Q:$D(DTOUT)!$D(DUOUT)
  1.  .S RMPRBCK=RMPRDA
  1.  .N DIC
  1.  .S RMPRDA=R19(660,RMPRBCK,72,"I")
  1.  .D DISP^RMPR293(RMPRDA)
  1.  .S RMPRDA=RMPRBCK K RMPRBCK
  1.  ;return from work order
  1.  G EXIT
  1.  ;
  1. HDR ;display heading
  1.  W @IOF,RMPRNAM,?30," SSN: "
  1.  W $E(RMPRSSN,1,3)_"-"_$E(RMPRSSN,4,5)_"-"_$E(RMPRSSN,6,10),?50
  1.  W $G(R19(660,RMPRDA,8,"E")),?70,"DOB: "
  1.  W $S(RMPRDOB:$E(RMPRDOB,4,5)_"-"_$E(RMPRDOB,6,7)_"-"_(1700+$E(RMPRDOB,1,3)),1:"Unknown")
  1.  W !?20,"APPLIANCE/REPAIR LINE ITEM DETAIL ",?70,"<4-",ANS,">",!
  1.  Q
  1. EXIT ;common exit point
  1.  I $Y>(IOSL-4) F  W ! Q:$Y>(IOSL-3)
  1.  N DIR S DIR(0)="E" D ^DIR
  1.  ;duout,dtout is evaluated in dis+1^rmprpat2
  1. EX1 ;back out through that point to clean up
  1.  K R19,RV,RMPRICD,RMPRICD,MSGICD,RMPRERR,Y W @IOF
  1.  Q
  1.  ;end