92 lines
3.7 KiB
Mathematica
92 lines
3.7 KiB
Mathematica
RMPR121C ;HINES-OI/HNC/SPS - IFCAP GUI TO 2319 ;3/1/2003
|
|
;;3.0;PROSTHETICS;**90,75,60**;Feb 09, 1996;Build 18
|
|
;
|
|
R19 ;PASS RMPRA AS IEN OF 644, AND B2 AS ITEM MULTIPLE
|
|
;S:$D(RMPRCONT) $P(^RMPR(664,RMPRA,1,B2,0),U,14)=RMPRCONT
|
|
S RMPRI=$P(^RMPR(664,RMPRA,1,B2,0),U,1),RMPRCT=$P(^(0),U,3)
|
|
S RMPRQT=$P(^RMPR(664,RMPRA,1,B2,0),U,4),RMPRDES=$P(^(0),U,2)
|
|
S RMPRPER=$P(^RMPR(664,RMPRA,2),U,6)/100
|
|
;contract data
|
|
S RMPRCONT=""
|
|
S RMPRCONT=$P(^RMPR(664,RMPRA,1,B2,0),U,14)
|
|
;TEMPORARY FIX FOR TRANSACTION TYPE AND PATIENT CATAGORY
|
|
S RMPRT=$P(^RMPR(664,RMPRA,1,B2,0),U,9),RMPRR=$P(^(0),U,8),RMPRDIS=$P(^(0),U,10),RMPRS=$P(^(0),U,12),UOI=$P(^(0),U,5),RMPRSLN=$P(^(0),U,15)
|
|
;
|
|
I RMPRT="R" S $P(^RMPR(664,RMPRA,1,B2,0),U,9)="X",RMPRT="X"
|
|
I RMPRDIS=2 S $P(^RMPR(664,RMPRA,1,B2,0),U,10)=1,RMPRDIS=1
|
|
I RMPRDIS=3 S $P(^RMPR(664,RMPRA,1,B2,0),U,10)=4,RMPRDIS=4
|
|
S RMPRSC=$P(^RMPR(664,RMPRA,1,B2,0),U,11) ;Special catagory
|
|
S RMPRNOB=$P(^RMPR(664,RMPRA,1,B2,0),U,17) ;NUMBER OF BIDS
|
|
S RMPRHCPC=$P(^RMPR(664,RMPRA,1,B2,0),U,16) ;PSAS HCPCS
|
|
S RMPRMK=$P(^RMPR(664,RMPRA,1,B2,2),U,1),RMPRMD=$P(^(2),U,2),RMPRLTN=$P(^(2),U,3),RMPREW=$P(^(2),U,4) ;MAKE,MODEL,LOT,EXCLUDE/WAVER
|
|
S RMCPT=$P($G(^RMPR(664,RMPRA,1,B2,4)),U,2) ;CPT MODIFIER
|
|
K DD,DO S DIC="^RMPR(660,",DIC(0)="QL",X=DT,DLAYGO=660
|
|
D FILE^DICN K DLAYGO,DIC,D0 S (RMPR660,DA)=+Y
|
|
S $P(^RMPR(664,RMPRA,1,B2,0),U,13)=RMPR660
|
|
S DA=RMPRA,DIK="^RMPR(664," D IX1^DIK
|
|
S RMPRAMT=(RMPRQT*RMPRCT)
|
|
S RMPRDCT=RMPRAMT*RMPRPER
|
|
S RMPRTOTL=RMPRAMT-RMPRDCT
|
|
;ctd is unit cost with percent discount applied.
|
|
S RMPRCTD=RMPRAMT-RMPRDCT/RMPRQT
|
|
;
|
|
S ^RMPR(660,RMPR660,0)=DT_U_RMPRDFN_U_DT_U_RMPRT_U_U_U_RMPRQT_U_UOI_U_RMPRV_U_RMPR("STA")_U_U_U_"14"_U_RMPRS_U_U_$J(RMPRTOTL,0,2)_"^^^^^^"
|
|
;SERIAL#,MAKE,MODEL,LOT#,EXCLUDE/WAVER
|
|
S $P(^RMPR(660,RMPR660,0),U,11)=RMPRSLN,$P(^(0),U,24)=RMPRLTN
|
|
S $P(^RMPR(660,RMPR660,9),U)=RMPRMK,$P(^(9),U,2)=RMPRMD
|
|
S $P(^RMPR(660,RMPR660,2),U,3)=RMPREW
|
|
;OIF/OEF
|
|
S DFN=RMPRDFN D SVC^VADPT
|
|
S RMPROEOI=$S(VASV(11)>0:"<!>",VASV(12)>0:"<!>",VASV(13)>0:"<!>",1:0)
|
|
D KVAR^VADPT
|
|
I RMPROEOI="<!>" S $P(^RMPR(660,RMPR660,5),U,1)=1
|
|
;CONTRACT #
|
|
S $P(^RMPR(660,RMPR660,2),U,9)=$P(^RMPR(664,RMPRA,1,B2,0),U,14)
|
|
; ITEM
|
|
S $P(^RMPR(660,RMPR660,0),U,6)=RMPRI
|
|
;NUMBER OF BIDS
|
|
S $P(^RMPR(660,RMPR660,2),U,10)=RMPRNOB
|
|
;HCPCS code
|
|
S:RMPRHCPC $P(^RMPR(660,RMPR660,0),U,22)=$P(^RMPR(661.1,RMPRHCPC,0),U,4)
|
|
;
|
|
S ^RMPR(660,RMPR660,"AMS")=RMPRG,^RMPR(660,RMPR660,"AM")=U_U_RMPRDIS_U_RMPRSC
|
|
; /SPS removed below from above line for 75 may re-use later
|
|
; I $D(RMPRWO),RMPRWO S $P(^("AM"),U,2)=1,$P(^RMPR(660,RMPR660,"LB"),U,5)=RMPRWO
|
|
S:$D(RMPRR) $P(^RMPR(660,RMPR660,0),U,18)=RMPRR
|
|
S RMPRTRN=$P(^RMPR(664,RMPRA,4),U,5)
|
|
S $P(^RMPR(660,RMPR660,0),U,27)=DUZ,^(1)=RMPRTRN_U_RMPRDES_"^^"_RMPRHCPC_"^^"_RMCPT
|
|
;If work order and no count fields need to be set
|
|
I +$P(^RMPR(664,RMPRA,0),U,17)>0 D NCNT
|
|
;note to supplier
|
|
;
|
|
S RMPRNS=""
|
|
S (D1,RD)=0
|
|
F S RD=$O(^RMPR(664,RMPRA,1,B2,1,RD)) Q:RD="" D
|
|
.S ^RMPR(660,RMPR660,"DES",RD,0)=^RMPR(664,RMPRA,1,B2,1,RD,0)
|
|
.I $L(RMPRNS)>160 Q
|
|
.S RMPRNS=RMPRNS_" "_^RMPR(664,RMPRA,1,B2,1,RD,0)
|
|
.S D1=RD
|
|
S ^RMPR(660,RMPR660,"DES",0)="^660.028^"_D1_U_D1
|
|
S:$D(RMPRDELN) ^RMPR(660,RMPR660,3)=RMPRDELN
|
|
;modified by #62
|
|
S ^TMP($J,"RMPRPCE",660,RMPR660)=RMPRG_"^"_$G(RMPRDFN)
|
|
;set x-refs
|
|
S DIK="^RMPR(660,",DA=RMPR660 D IX1^DIK
|
|
K RMPRTRN
|
|
Q
|
|
NCNT ; ADD NO ADMIN COUNT TO 660 FOR WORK ORDER
|
|
;
|
|
S RMIE1=$P(^RMPR(664,RMPRA,0),U,17)
|
|
S RMRWO=$P(^RMPR(664.1,RMIE1,0),U,13)
|
|
S RMDAT(660,RMPR660_",",72.5)=RMRWO
|
|
S RMDAT(660,RMPR660_",",72)=RMIE1
|
|
S RMDAT(660,RMPR660_",",81)=1
|
|
S RMDAT(660,RMPR660_",",11)=14
|
|
S RMDAT(660,RMPR660_",",12)="C"
|
|
D FILE^DIE("","RMDAT","RMERROR")
|
|
I $D(RMERROR) S RESULT(0)=1_U_RMERROR G EXIT
|
|
Q
|
|
EXIT ;
|
|
K RMIE1,RMRWO,RMPRA,RMPR660
|
|
Q
|