84 lines
3.7 KiB
Mathematica
84 lines
3.7 KiB
Mathematica
|
RMPR5NEE ;HIN/RVD-PROS INVENTORY EDIT UTILITY ;2/11/98
|
||
|
|
;;3.0;PROSTHETICS;**33,37**;Feb 09, 1996
|
||
|
|
D DIV4^RMPRSIT I $D(Y),(Y<0) K DIC("B") Q
|
||
|
|
;S RMKEY=$O(^DIC(19.1,"B","RMPRMANAGER",0))
|
||
|
|
S X="NOW" D ^%DT
|
||
|
|
LOC ;ask for Location.
|
||
|
|
W @IOF,!!,"Editing an Inventory Item in a Location.....",! K DTOUT,DUOUT,DIC("B")
|
||
|
|
S DZ="??",D="B",DIC("S")="I $P(^RMPR(661.3,+Y,0),U,3)=RMPR(""STA"")"
|
||
|
|
S DIC="^RMPR(661.3,",DIC(0)="AEQM"
|
||
|
|
S D="B",DIC("A")="Enter Pros Location: " D MIX^DIC1
|
||
|
|
G:$D(DTOUT)!$D(DUOUT)!(Y'>0) EXIT S (DA,RMLODA)=+Y
|
||
|
|
L +^RMPR(661.3,RMLODA):2
|
||
|
|
I '$T W !,"Record in use. Try again later..." G LOC
|
||
|
|
S RML=$P(^RMPR(661.3,RMLODA,0),U,1)
|
||
|
|
S DIE=DIC,DR=".01" D ^DIE K DIE,DR
|
||
|
|
G:$D(Y)!'$D(^RMPR(661.3,RMLODA,0)) LOC
|
||
|
|
S RMLOC=$P(^RMPR(661.3,RMLODA,0),U,1),DIK=DIC W:RML'=RMLOC !,"Location has been edited from '"_RML_"' to '"_RMLOC_"' !!!"
|
||
|
|
I $P(^RMPR(661.3,RMLODA,0),U,3)="" S $P(^(0),U,3)=RMPR("STA") D IX1^DIK
|
||
|
|
L -^RMPR(661.3,RMLODA)
|
||
|
|
;
|
||
|
|
LIST ;list current HCPCS @ this Location
|
||
|
|
K DIC("S"),RMR,RMX S DIC("A")="Select HCPCS to EDIT: ",DA(1)=RMLODA
|
||
|
|
S DIC="^RMPR(661.3,"_DA(1)_",1,",DIC(0)="AEMQ",DIC("W")="S RZ=$P(^RMPR(661.3,RMLODA,1,+Y,0),U,1) I RZ W ?15,$P(^RMPR(661.1,RZ,0),U,2)"
|
||
|
|
D ^DIC I +Y'>0!$D(DTOUT)!$D(DUOUT) W !,"** No HCPCS selected..." H 1 G LOC
|
||
|
|
S RMDAHC=$P($G(^RMPR(661.3,RMLODA,1,+Y,0)),U,1),RMHCPC=$P(^RMPR(661.1,RMDAHC,0),U,1),RMHCDA=+Y
|
||
|
|
S DA(2)=RMLODA,DA(1)=RMHCDA K DIC
|
||
|
|
ITEM ;ask for PSAS Item to to edit.
|
||
|
|
S DIC("A")="Enter PSAS Item to Edit: ",DIC(0)="AEMNQ"
|
||
|
|
S DIC="^RMPR(661.3,"_DA(2)_",1,"_DA(1)_",1,"
|
||
|
|
D ^DIC
|
||
|
|
G:Y'>0!$D(DTOUT)!$D(DUOUT) LOC
|
||
|
|
L +^RMPR(661.3,RMLODA,1,RMHCDA,1,+Y):2
|
||
|
|
I '$T W !,"Record in use. Try again later..." G LOC
|
||
|
|
;
|
||
|
|
;for item in 661.3
|
||
|
|
S (DA,RMITDA)=+Y,RDIC3=DIC K DIC("B")
|
||
|
|
S RM3=^RMPR(661.3,RMLODA,1,RMHCDA,1,RMITDA,0),RMIT=$P(RM3,U,1),RMDAIT=$P(RMIT,"-",2)
|
||
|
|
S RMITEM=$P(^RMPR(661.1,RMDAHC,3,RMDAIT,0),U,1)
|
||
|
|
S RMQU=$P(RM3,U,2),RMCO=$P(RM3,U,3) S:'RMQU RMQU=0 S:'RMCO RMCO=0
|
||
|
|
;
|
||
|
|
UPD ;updates item in 661.3
|
||
|
|
S (RMAVA,RMQUD,RMCOD)=0,DIE=RDIC3
|
||
|
|
S DR="29;22R;23R~TOTAL COST OF QUANTITY;24;25R;26;27"
|
||
|
|
D ^DIE
|
||
|
|
S RM3A=^RMPR(661.3,RMLODA,1,RMHCDA,1,RMITDA,0)
|
||
|
|
S RMQUA=$P(RM3A,U,2),RMCOA=$P(RM3A,U,3),RMAVA=$P(RM3A,U,10),RMSO=$P(RM3A,U,9)
|
||
|
|
I RMQUA=RMQU,RMCOA=RMCO G LOC
|
||
|
|
I (RMSO="C")&(RMCOA<.0001) G LIST
|
||
|
|
I RMSO="C" S:RMAVA<1&RMQUA>0 RMAVA=RMCOA/RMQUA
|
||
|
|
I RMCO'=RMCOA S RMCOD=RMCOA-RMCO
|
||
|
|
I RMQU'=RMQUA S RMQUD=RMQUA-RMQU
|
||
|
|
I RMQUD,'RMCOD S RMCOA=RMAVA*RMQUA
|
||
|
|
I 'RMQUD,RMCOD S:RMQUA>0 RMAVA=RMCOA/RMQUA
|
||
|
|
I RMQUD,RMCOD S:RMQUA>0 RMAVA=RMCOA/RMQUA
|
||
|
|
S $P(^RMPR(661.3,RMLODA,1,RMHCDA,1,RMITDA,0),U,3)=RMCOA
|
||
|
|
S $P(^RMPR(661.3,RMLODA,1,RMHCDA,1,RMITDA,0),U,8)=RMITEM
|
||
|
|
S $P(^RMPR(661.3,RMLODA,1,RMHCDA,1,RMITDA,0),U,10)=$J(RMAVA,0,2)
|
||
|
|
;
|
||
|
|
STAT ;create an item statistics for this event.
|
||
|
|
G:RMQU=RMQUA&(RMCO=RMCOA) LIST
|
||
|
|
D BAL^RMPR5NU1
|
||
|
|
L -^RMPR(661.3,RMLODA,1,RMHCDA,1,RMITDA)
|
||
|
|
K DD,DO S DIC="^RMPR(661.2,",DIC(0)="L",X=DT,DLAYGO=661.2 D FILE^DICN
|
||
|
|
G:$D(DTOUT)!(Y'>0) LIST S DA=+Y
|
||
|
|
S RMMESF="Edited by "_$E($P(^VA(200,DUZ,0),U,1),1,15)_": ("
|
||
|
|
S RMMESF=RMMESF_$S(RMQUD>0:"+"_RMQUD_")",1:RMQUD_")")
|
||
|
|
S ^RMPR(661.2,DA,0)=DT_"^^^"_RMDAHC_"^^^"_DUZ_"^"_RMQUD_"^"_RMIT_"^^^"_RMTOBA_"^"_RMMESF_"^"_$J(RMTOCO,0,2)_"^"_RMPR("STA")_"^"_RMLODA_"^"_$J(RMAVA,0,2) S DIK=DIC D IX1^DIK
|
||
|
|
W !!,"** Item ",RMITEM," was ",RMMESF," @ Location ",RMLOC
|
||
|
|
H 2 G LIST
|
||
|
|
;
|
||
|
|
DEL ;delete a location
|
||
|
|
S DIR(0)="Y",DIR("B")="N"
|
||
|
|
W !,"This will DELETE all HCPCS and ITEMS under this LOCATION..."
|
||
|
|
S DIR("A")="Are you sure you want to DELETE this LOCATION (Y/N) "
|
||
|
|
D ^DIR I $D(DTOUT)!$D(DUOUT) S RMX=RMR("B") S:Y="^" RMEXIT=1 Q
|
||
|
|
L +^RMPR(661.3,RMLODA):2
|
||
|
|
I '$T W !,"Record in use. Try again later..." S RMEXIT=1 Q
|
||
|
|
I Y>0 S DIK="^RMPR(661.3,",DA=RMLODA D ^DIK W:'$D(^RMPR(661.3,RMLODA,0)) !,"Location is deleted!!!!" H 2 K DIR,DIK,X
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
EXIT ;MAIN EXIT POINT
|
||
|
|
N RMPR,RMPRSITE D KILL^XUSCLEAN
|
||
|
|
Q
|