168 lines
7.0 KiB
Mathematica
168 lines
7.0 KiB
Mathematica
RMPRE29 ;PHX/JLT,RVD-EDIT 2319 ;10/2/03 13:04
|
|
;;3.0;PROSTHETICS;**36,41,51,57,62,74,81,61**;Feb 09, 1996
|
|
;
|
|
;RVD patch #62 - call PCE API to update patient care encounter.
|
|
; - add a screen display if no changes to the HCPCS.
|
|
;RVD patch #74 - call $$STATCHK^ICPTAPIU to check if CPT Code is
|
|
; active for a given date.
|
|
;RVD patch #81 - roll back patch RMPR*3.0*74 and returns the screen
|
|
; to the STATUS field of file #661.1.
|
|
;RVD patch #61 - Bar Coding. Don't include Stock Issue for ED2.
|
|
;uses DBIA # 1995 & 1997.
|
|
W ! S DIC="^RMPR(660,",DIC(0)="AEMQZ",DIC("A")="Select PATIENT: "
|
|
S DIC("W")="D EN^RMPRD1",RMEND=0
|
|
S DIC("S")="I ($P(^(0),U,6)!($P(^(0),U,26)'="""")),($P(^(0),U,13)'=11)" W !
|
|
D ^DIC G:+Y'>0 EXIT L +^RMPR(660,+Y,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" G EXIT
|
|
;S (RMPRDA,DA)=+Y,DIE=DIC,DR="[RMPRE2319]" D ^DIE L -^RMPR(660,DA,0)
|
|
S DIE=DIC,(RMPRDA,DA)=+Y
|
|
TYP1 ;edit type of transaction....
|
|
S R1(0)=$G(^RMPR(660,RMPRDA,0)),R1(1)=$G(^(1)),R1("AM")=$G(^("AM"))
|
|
S RMTOTCOS=$P(R1(0),U,16)
|
|
S (RMHCPC,RMHCOLD)=$P(R1(1),U,4),(RMTYPE,RMTYPS)=$P(R1(0),U,4),(RMCAT,RMCATS)=$P(R1("AM"),U,3),(RMSPE,RMSPES)=$P(R1("AM"),U,4),RMSOUR=$P(R1(1),U,14)
|
|
TRAN K DIR S DIR(0)="660,2"
|
|
;S DIR("A")="Enter Type of Transaction: "
|
|
S:$D(RMTYPS) DIR("B")=$S(RMTYPS="I":"INITIAL",RMTYPS="X":"REPAIR",RMTYPS="R":"REPLACE",RMTYPS="S":"SPARE",1:"")
|
|
D ^DIR
|
|
I $D(DUOUT)!$D(DTOUT) S RMEND=1 D SETED2 G QED2
|
|
I Y="" W !,"Please enter type of Transaction!!" G TRAN
|
|
S $P(R1(0),U,4)=Y,RMTYPE=Y
|
|
S RMTYPS=$S(Y="I":"INITIAL",Y="X":"REPAIR",Y="R":"REPLACE",Y="S":"SPARE",1:"")
|
|
PCAT K DIR S DIR(0)="660,62"
|
|
S:$D(RMCATS) DIR("B")=$S(RMCATS=1:"SC/OP",RMCATS=2:"SC/IP",RMCATS=3:"NSC/IP",RMCATS=4:"NSC/OP",1:"")
|
|
D ^DIR
|
|
I $D(DUOUT)!$D(DTOUT) S RMEND=1 D SETED2 G QED2
|
|
I Y="" W !,"Please enter Patient Category!!" G PCAT
|
|
S RMCAT=Y
|
|
S $P(R1("AM"),U,3)=Y,RMCATS=$S(Y=1:"SC/OP",Y=2:"SC/IP",Y=3:"NSC/IP",Y=4:"NSC/OP",1:"")
|
|
K DIR I RMCAT<4 S $P(R1("AM"),U,4)="" G HCPC
|
|
S DIR(0)="660,63"
|
|
S:$D(RMSPES) DIR("B")=$S(RMSPES=1:"SPECIAL LEGISLATION",RMSPES=2:"A&A",RMSPES=3:"PHC",RMSPES=4:"ELIGIBILITY REFORM",1:"")
|
|
I RMCAT=4 D ^DIR I $D(DUOUT)!$D(DTOUT) S RMEND=1 D SETED2 G QED2
|
|
I RMCAT=4 S $P(R1("AM"),U,4)=Y,RMSPE=Y,RMSPES=$S(Y=1:"SPECIAL LEGISLATION",Y=2:"A&A",Y=3:"PHC",Y=4:"ELIGIBILITY REFORM",1:"")
|
|
K DIR
|
|
;
|
|
HCPC ;set type and ask item and HCPCS
|
|
D SETED2
|
|
;ask source
|
|
N SRC
|
|
S SRC=$P(R1(0),U,14)
|
|
S DIE("NO^")="BACK"
|
|
S DR="12;4;4.5" D ^DIE
|
|
K DIE("NO^")
|
|
I $D(DUOUT)!$D(DTOUT)!$D(Y) S RMEND=1 G QED2
|
|
S R1(0)=$G(^RMPR(660,RMPRDA,0)),R1(1)=$G(^(1))
|
|
I $P(R1(0),U,14)'=SRC S RMHCOLD=""
|
|
S RMHCPC=$P(R1(1),U,4)
|
|
W !,"OLD CPT MODIFER: ",$P(R1(1),U,6)
|
|
;if HCPCS was changed, Modifier must be changed
|
|
I RMHCOLD'=RMHCPC D
|
|
.S RDA=RMHCPC_"^"_$P(R1(0),U,4)_"^"_$P(R1(0),U,14)_"^"_660
|
|
.D CPT^RMPRCPTU(RDA) S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT
|
|
.W !,"NEW CPT MODIFIER: ",RMCPT
|
|
;if HCPCS the same, ask user if want to edit modifier.
|
|
E D
|
|
.S DIR(0)="Y",DIR("B")="N",DIR("A")="Would you like to edit the CPT Modifier "
|
|
.D ^DIR Q:$D(DUOUT)!$D(DTOUT)
|
|
.I (Y>0) D
|
|
..S RDA=RMHCPC_"^"_$P(R1(0),U,4)_"^"_$P(R1(0),U,14)_"^"_660
|
|
..D CPT^RMPRCPTU(RDA) S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT
|
|
..K DIR
|
|
..W:RMCPT=$P(R1(1),U,6) !!,"***Based on the information given above, CPT modifier string has not changed!!!",!
|
|
..W:RMCPT'=$P(R1(1),U,6) !,"NEW CPT MODIFIER: ",RMCPT
|
|
S DR="7;5;14;9;21;16;28" D ^DIE
|
|
I RMTOTCOS'=$P(^RMPR(660,DA,0),U,16) S DR="35////^S X=DUZ;36////^S X=DT" D ^DIE
|
|
I $D(DTOUT)!('$G(Y))!($D(DUOUT)) D CHK
|
|
QED2 ;
|
|
Q:$D(RMPREDT)
|
|
;modified by #62
|
|
;call PCE API to update patient care encounter.
|
|
I $D(^RMPR(660,RMPRDA,10)),$P(^RMPR(660,RMPRDA,10),U,12) D
|
|
.S RMCHK=$$SENDPCE^RMPRPCEA(RMPRDA)
|
|
.I RMCHK<1 H 3
|
|
L -^RMPR(660,RMPRDA,0)
|
|
K DIR W ! S DIR(0)="Y",DIR("A")="Would You like to Edit another Entry (Y/N) " D ^DIR
|
|
G:'$D(DTOUT)&(Y>0) RMPRE29
|
|
EXIT ;
|
|
N RMPR,RMPRSITE D KILL^XUSCLEAN
|
|
K DIC,DIE,DIR,%,X,Y
|
|
Q
|
|
SETED2 ;set 660
|
|
S ^RMPR(660,DA,0)=R1(0),^RMPR(660,DA,1)=R1(1),^RMPR(660,DA,"AM")=R1("AM")
|
|
S DIK="^RMPR(660,",DA=RMPRDA D IX1^DIK K DIC
|
|
D CHK
|
|
Q
|
|
;
|
|
QUICK ;quick edit for HCPCS and type
|
|
K RMCPT
|
|
W ! S DIC="^RMPR(660,",DIC(0)="AEMNQZ",DIC("A")="Select NUMBER, or Patient: "
|
|
S DIC("W")="D EN^RMPRD1"
|
|
S DIC("S")="I $P(^(0),U,6)!($P(^(0),U,26)'="""")" W !
|
|
D ^DIC G:+Y'>0 EXIT L +^RMPR(660,+Y,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" G EXIT
|
|
;add source
|
|
S (RMPRDA,DA)=+Y,DIE=DIC,DR="2;4.5"
|
|
S R1(0)=$G(^RMPR(660,DA,0)),R1(1)=$G(^RMPR(660,DA,1))
|
|
S RMTYPE=$P(R1(0),U,4),RMSOUR=$P(R1(0),U,14)
|
|
S RMHCOLD=$P(R1(1),U,4)
|
|
D ^DIE G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(Y) SET
|
|
S RMHCNEW=$P($G(^RMPR(660,DA,1)),U,4)
|
|
S RMTYPE=$P($G(^RMPR(660,DA,0)),U,4)
|
|
S RDA=RMHCNEW_"^"_RMTYPE_"^"_RMSOUR_"^"_660
|
|
W !,"OLD CPT MODIFER: ",$P(R1(1),U,6)
|
|
I RMHCOLD'=RMHCNEW D
|
|
.D CPT^RMPRCPTU(RDA)
|
|
.W !,"NEW CPT MODIFIER: ",RMCPT
|
|
.S $P(^RMPR(660,DA,1),U,6)=RMCPT
|
|
I RMHCOLD=RMHCNEW D
|
|
.W ! S DIR("B")="N",DIR(0)="Y",DIR("A")="Would You like to Edit CPT MODIFIER " D ^DIR
|
|
.I $D(DTOUT)!('$G(Y)) K DIR Q
|
|
.D CPT^RMPRCPTU(RDA)
|
|
.W:RMCPT=$P(R1(1),U,6) !!,"***Based on the information given above, CPT modifier string has not changed!!!",!
|
|
.W:RMCPT'=$P(R1(1),U,6) !,"NEW CPT MODIFIER: ",RMCPT
|
|
.S $P(^RMPR(660,DA,1),U,6)=RMCPT
|
|
SET K DIR D CHK
|
|
;modified by #62
|
|
;call PCE API to update patient care encounter
|
|
I $D(^RMPR(660,RMPRDA,10)),$P(^RMPR(660,RMPRDA,10),U,12) D
|
|
.S RMCHK=$$SENDPCE^RMPRPCEA(RMPRDA)
|
|
.I RMCHK<1 H 3
|
|
W ! S DIR(0)="Y",DIR("A")="Would You like to Edit another Entry (Y/N)" D ^DIR
|
|
G:'$D(DTOUT)&(Y>0) QUICK^RMPRE29
|
|
L -^RMPR(660,RMPRDA,0)
|
|
D KILL^XUSCLEAN Q
|
|
;
|
|
CHK ;check for transaction changes
|
|
S RMTYPE=$P($G(^RMPR(660,RMPRDA,0)),U,4)
|
|
S RMHCPC=$P($G(^RMPR(660,RMPRDA,1)),U,4) Q:'$G(RMHCPC)
|
|
S RMCPT1=$P($G(^RMPR(661.1,RMHCPC,4)),U,1)
|
|
S RMCPT=$P($G(^RMPR(660,RMPRDA,1)),U,6)
|
|
I ((RMTYPE="R")!(RMTYPE="X")),(RMCPT'["RP"),($G(^RMPR(661.1,RMHCPC,4))["RP") D ADDRP
|
|
I ((RMTYPE="I")!(RMTYPE="S")),(RMCPT["RP") D DELRP
|
|
I (RMSOUR="C"),(RMCPT["RR") D DELNU
|
|
I (RMSOUR="C"),(RMCPT'["RR"),(RMCPT1["NU"),(RMCPT'["N") D ADDNU
|
|
K RMHCPC,RMCI,RMC,RMCLEN,RMLPIECE,RMF,RMFPIECE,RMTYPE,RMPRA,R4DA Q
|
|
;return to EDIT option
|
|
DELRP ;logic for deleting 'RP' modifier with transaction change.
|
|
F RMCI=1:1:8 S RMC=$P(RMCPT,",",RMCI) I RMC="RP" S $P(RMCPT,",",RMCI)="" D
|
|
.S RMF=$F(RMCPT,",,"),RMFPIECE=$E(RMCPT,1,RMF-2)
|
|
.S RMLPIECE=$E(RMCPT,RMF,32),RMCPT=RMFPIECE_RMLPIECE,RMCLEN=$L(RMCPT)
|
|
.I $E(RMCPT,1)="," S RMCPT=$E(RMCPT,2,RMCLEN)
|
|
.I $E(RMCPT,RMCLEN)="," S RMCPT=$E(RMCPT,1,RMCLEN-1)
|
|
.S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT
|
|
Q
|
|
DELNU ;logic for deleting 'NU' modifier.
|
|
F RMCI=1:1:8 S RMC=$P(RMCPT,",",RMCI) I RMC="NU" S $P(RMCPT,",",RMCI)="" D
|
|
.S RMF=$F(RMCPT,",,"),RMFPIECE=$E(RMCPT,1,RMF-2)
|
|
.S RMLPIECE=$E(RMCPT,RMF,32),RMCPT=RMFPIECE_RMLPIECE,RMCLEN=$L(RMCPT)
|
|
.I $E(RMCPT,1)="," S RMCPT=$E(RMCPT,2,RMCLEN)
|
|
.I $E(RMCPT,RMCLEN)="," S RMCPT=$E(RMCPT,1,RMCLEN-1)
|
|
.S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT
|
|
Q
|
|
;
|
|
ADDRP ;logic for adding 'RP' modifier with transaction change.
|
|
S RMCPT=RMCPT_",RP" S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT
|
|
Q
|
|
ADDNU ;logic for adding 'NU' modifier.
|
|
S RMCPT=RMCPT_",NU" S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT
|
|
Q
|
|
;END
|