116 lines
3.9 KiB
Mathematica
116 lines
3.9 KiB
Mathematica
RMPRED5 ;HIN/RVD-EDIT ISSUE FROM STOCK UTILITY;2/1/1999
|
|
;;3.0;PROSTHETICS;**33,41,53**;Feb 09, 1996
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
NHCPC(RX) ;HCPCS, location or psas/item different
|
|
D NEWVAR
|
|
D RMVAR
|
|
I $G(RO),$G(RHO) D
|
|
.S RMHCPC=RHO,RL=RO
|
|
.S:$G(RMHCPC)&$G(RL) RMHCDA=$$RMHC
|
|
.S RMQTY=RQO*-1,RMIT=RIO
|
|
.I RH'=RHO,$G(RMSTOCK) S $P(^RMPR(661.2,RMSTOCK,0),U,2)="",$P(^(0),U,13)=RMDESC
|
|
D:$G(RMHCDA) UPD
|
|
S (RMHCDA,RD6612)=""
|
|
I $G(RN),$G(RH) D
|
|
.S RMHCPC=RH,RL=RN
|
|
.S:$G(RMHCPC)&$G(RL) RMHCDA=$$RMHC
|
|
.S RMQTY=RQ,RMIT=RI S:(RH'=RHO) RSO=RSOUR,RDF=RF
|
|
D:$G(RMHCDA) UPD
|
|
S:$G(RL) $P(^RMPR(660,RMPRIEN,1),U,5)=RD6612
|
|
I $G(RH)'=$G(RHO) S $P(^RMPR(660,RMPRIEN,1),U,2)=RDES
|
|
D SETC
|
|
Q
|
|
;
|
|
QTYN(RX) ;change quantity
|
|
D NEWVAR
|
|
D RMVAR
|
|
S RMHCPC=RH,RL=RN
|
|
S:$G(RMHCPC)&$G(RL) RMHCDA=$$RMHC
|
|
S RMQTY=RQ-RQO,RMIT=RI
|
|
S RDF=RF,RSO=RSOUR
|
|
D:$G(RMHCDA) UPD
|
|
S:$G(RL) $P(^RMPR(660,RMPRIEN,1),U,2)=RDES
|
|
D SETC
|
|
Q
|
|
;
|
|
NEWVAR N X,Y,RMQTY,RMIT,RMHCPC,RMHCDA,RMLOC
|
|
N RD6612,RMBA,RBAL,RAVA,RAV,RSOUR,RSO
|
|
Q
|
|
;
|
|
RMVAR ;piece array variable
|
|
S (RDF,RSO)=""
|
|
S RN=$P(RX,"^",1)
|
|
S RH=$P(RX,"^",2)
|
|
S RHO=$P(RX,"^",3)
|
|
S RO=$P(RX,"^",4)
|
|
S RI=$P(RX,"^",5)
|
|
S RIO=$P(RX,"^",6)
|
|
S RQ=$P(RX,"^",7)
|
|
S RQO=$P(RX,"^",8)
|
|
S RSOUR=$P(RX,"^",9)
|
|
S RF=$P(RX,"^",10)
|
|
S RMDESC="Edited/Returned STOCK ISSUE"
|
|
Q
|
|
;
|
|
RMHC() ; get HCPCS IEN in #661.3
|
|
N Y
|
|
S Y=$O(^RMPR(661.3,RL,1,"B",RMHCPC,0))
|
|
Q Y
|
|
;
|
|
UPD ;update Pros Inventory balance.
|
|
Q:'$G(RMHCDA)!'$G(RL)!'$D(RMIT)
|
|
S:$D(^RMPR(661.3,RL,1,RMHCDA,0)) RMITDA=$O(^RMPR(661.3,RL,1,RMHCDA,1,"B",RMIT,0))
|
|
Q:'$G(RMITDA)
|
|
S (RBAL,RCOS)=0 D
|
|
.S RMBA=$P(^RMPR(661.3,RL,1,RMHCDA,1,RMITDA,0),U,2),RBAL=RMBA-RMQTY
|
|
.S RMCO=$P(^RMPR(661.3,RL,1,RMHCDA,1,RMITDA,0),U,3)
|
|
.S (RAVA,RAV)=$P(^RMPR(661.3,RL,1,RMHCDA,1,RMITDA,0),U,10)
|
|
.S $P(^RMPR(661.3,RL,1,RMHCDA,1,RMITDA,0),U,2)=RBAL
|
|
.S $P(^RMPR(661.3,RL,1,RMHCDA,1,RMITDA,0),U,3)=RBAL*RAV
|
|
S RMDAHC=RMHCPC
|
|
D BAL^RMPR5NU1
|
|
S X=DT,DIC(0)="AEQL",DLAYGO=661.2,DIC="^RMPR(661.2," K DD,DO
|
|
D FILE^DICN K DLAYGO S RMCOM="Edited/Returned STOCK ISSUE" ;("_RMQTY_")"
|
|
S ^RMPR(661.2,+Y,0)=DT_"^"_RDF_"^"_RSO_"^"_RMDAHC_"^^^"_DUZ_"^"_RMQTY_"^"_RMIT_"^^^"_RMTOBA_"^"_RMCOM_"^"_$J(RMTOCO,0,2)_"^"_RMPR("STA")_"^"_RL_"^"_RAVA
|
|
S (RD6612,DA)=+Y,DIK=DIC D IX1^DIK
|
|
Q
|
|
;
|
|
SETC ;
|
|
K ^RMPR(660,"AD",$P(R12(0),U,6),RMPRIEN) K:$P(R12(0),U,12)'="" ^RMPR(660,"CT",$P(R12(0),U,12),RMPRIEN)
|
|
Q
|
|
;
|
|
CHK ;check for source and type of transaction changes.
|
|
S RMCPTOLD=$P(R1(1),U,6),RMSONEW=$P(R1(0),U,14),RMTYNEW=$P(R1(0),U,4)
|
|
Q:'$G(RMHCPC)
|
|
S RMCPT1=$G(^RMPR(661.1,RMHCPC,4))
|
|
I (RMSONEW="C"),(RMCPTOLD["UE"),(RMCPT1["NU") D SOUC
|
|
I (RMSONEW="C"),(RMCPTOLD'["RR"),(RMCPTOLD'["NU"),(RMCPT1["NU") S $P(R1(1),U,6)=RMCPTOLD_",NU"
|
|
I (RMSONEW="C"),(RMCPTOLD["RR") S RMRR="NU" D DELRPRR
|
|
I (RMSONEW="V"),(RMCPTOLD["RR") S RMRR="RR" D DELRPRR
|
|
I (RMSONEW="V"),(RMCPTOLD["NU"),(RMCPT1["UE") D SOUV
|
|
I (RMSONEW="V"),(RMCPTOLD'["NU"),(RMCPTOLD'["UE"),(RMCPT1["UE") S $P(R1(1),U,6)=RMCPTOLD_",UE"
|
|
I ((RMTYNEW="R")!(RMTYNEW="X")),(RMCPTOLD'["RP"),(RMCPT1["RP") D ADDRP
|
|
I ((RMTYNEW="I")!(RMTYNEW="S")),(RMCPTOLD["RP") S RMRR="RP" D DELRPRR
|
|
Q
|
|
SOUC ;logic for updating SOURCE change for commercial.
|
|
F RMCI=1:1 S RMC=$P(RMCPTOLD,",",RMCI) I RMC="UE" S $P(RMCPTOLD,",",RMCI)="NU" S $P(R1(1),U,6)=RMCPTOLD Q
|
|
Q
|
|
;
|
|
SOUV ;logic for updating SOURCE change for VA.
|
|
F RMCI=1:1 S RMC=$P(RMCPTOLD,",",RMCI) I RMC="NU" S $P(RMCPTOLD,",",RMCI)="UE" S $P(R1(1),U,6)=RMCPTOLD Q
|
|
Q
|
|
;
|
|
DELRPRR ;logic for deleting 'RP' or 'RR' modifier with transaction change.
|
|
F RMCI=1:1:8 S RMC=$P(RMCPTOLD,",",RMCI) I RMC=RMRR S $P(RMCPTOLD,",",RMCI)="" D
|
|
.S RMF=$F(RMCPTOLD,",,"),RMFPIECE=$E(RMCPTOLD,1,RMF-2)
|
|
.S RMLPIECE=$E(RMCPTOLD,RMF,32),RMCPTOLD=RMFPIECE_RMLPIECE,RMCLEN=$L(RMCPTOLD)
|
|
.I $E(RMCPTOLD,1)="," S RMCPTOLD=$E(RMCPTOLD,2,RMCLEN)
|
|
.I $E(RMCPTOLD,RMCLEN)="," S RMCPTOLD=$E(RMCPTOLD,1,RMCLEN-1)
|
|
.S $P(R1(1),U,6)=RMCPTOLD
|
|
K RMRR Q
|
|
;
|
|
ADDRP ;logic for adding 'RP' modifier with transaction change.
|
|
S RMCPTOLD=RMCPTOLD_",RP" S $P(R1(1),U,6)=RMCPTOLD
|
|
Q
|