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