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

RMPOPAT3.m

Go to the documentation of this file. 
  1. RMPOPAT3 ;HINES-CIOFO/RVD-Detail Display Patient 10-2319 Transaction;11/04/04
  1.  ;;3.0;PROSTHETICS;**70,92,99,182,194**;Feb 09, 1996;Build 5
  1.  ;
  1.  ; RVD 7/8/02 patch #70 - this routine is a copy of RMPRPAT3.
  1.  ;                        For Read Only 2319.
  1.  ; AAC 08/03/04 Patch 92 - Code Set Versioning (CSV) 
  1.  ;Used API=ICDDX^ICDCODE to replace direct calls to global ICD9(80).
  1.  ;
  1.  ;DBIA # 10082 - file #80, global read.
  1.  ;
  1.  ;RMPR*3.0*182 Modified system to be able to pull the 
  1.  ;             ext code and description for ICD10.
  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 RMPOPAT2
  1.  ;get 2319 transaction
  1.  ;
  1.  N DIC,DIQ,DR,DA,RMPRV,RMPRDA,RV
  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.  ;historical item
  1.  W !,"ITEM DESCRIPTION: ",$G(R19(660,RMPRDA,89,"E"))
  1.  W ?55,"DATE: ",$G(R19(660,RMPRDA,1,"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 !?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 !
  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.  ;
  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"))
  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 changes to item description
  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 !,"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.  ; RMPR*3*182 Changes to handle BOTH ICD9 and ICD10 internal pointers
  1.  ; RMPR*3.0*194 New variables and updates to use ICD API
  1.  N RMPRDRG,RMPRICDD,RMPRICDC,RMPRICD,RMPRIC9,RMPRCOD,RMPRDAT
  1.  S (RMPRICD,RMPRIC9,RMPRCOD,RMPRDAT)="" S RMPRERR=0
  1.  S RMPRDAT=$P($G(^RMPR(660,RMPRDA,0)),U)
  1.  I $D(^RMPR(660,RMPRDA,10)) S RMPRICD=$P($G(^RMPR(660,RMPRDA,10)),U,8)
  1.  I RMPRICD D
  1.  . S RMPRDRG=$$ICDDX^ICDEX(RMPRICD,RMPRDAT,,"I") ;RMPR*3.0*194 Check if null before setting RMPRICDC
  1.  . S RMPRICDC=$P(RMPRDRG,U,2),RMPRICDD=$P(RMPRDRG,U,4)
  1.  S RMPRICDT=$S(RMPRICD<50000:9,1:10)
  1.  I RMPRICD="" W !,"ICD Message:  ** NO CODE AVAILABLE **"
  1.  I RMPRICD'="" W !,"ICD",RMPRICDT,": ",RMPRICDC,"   ",RMPRICDD
  1.  ;
  1.  ; End Patch 92
  1.  ;
  1.  W !,"CPT MODIFIER: ",$G(R19(660,RMPRDA,4.7,"E"))
  1.  W !,"DESCRIPTION: ",$G(R19(660,RMPRDA,24,"E"))
  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.  S RMOXY=Y
  1.  ;duout,dtout is evaluated in dis+1^rmpopat2
  1. EX1 ;back out through that point to clean up
  1.  K R19,RV,RMPRICC,RMPRICD,RMPRIC9,RMPRCOD,RMPRDAT,RMPRERR,Y W @IOF
  1.  Q
  1.  ;end