RMPRE29C ;PHX/JLT,RVD-EDIT 2319 ;10/2/03 13:04
;;3.0;PROSTHETICS;**150**;Feb 09, 1996;Build 10
;
;Used to carve out edting of Vendor, Quantity and Cost
;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 DIE=DIC,(RMPRDA,DA)=+Y
S R1(0)=$G(^RMPR(660,RMPRDA,0)),R1(1)=$G(^(1)),R1("AM")=$G(^("AM"))
S RMTOTCOS=$P(R1(0),U,16)
;
S DR="7;5;14" 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))
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) RMPRE29C
EXIT ;
N RMPR,RMPRSITE D KILL^XUSCLEAN
K DIC,DIE,DIR,%,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRE29C 956 printed Oct 16, 2024@18:34:54 Page 2
RMPRE29C ;PHX/JLT,RVD-EDIT 2319 ;10/2/03 13:04
+1 ;;3.0;PROSTHETICS;**150**;Feb 09, 1996;Build 10
+2 ;
+3 ;Used to carve out edting of Vendor, Quantity and Cost
+4 ;uses DBIA # 1995 & 1997.
+5 WRITE !
SET DIC="^RMPR(660,"
SET DIC(0)="AEMQZ"
SET DIC("A")="Select PATIENT: "
+6 SET DIC("W")="D EN^RMPRD1"
SET RMEND=0
+7 SET DIC("S")="I ($P(^(0),U,6)!($P(^(0),U,26)'="""")),($P(^(0),U,13)'=11)"
WRITE !
+8 DO ^DIC
if +Y'>0
GOTO EXIT
LOCK +^RMPR(660,+Y,0):1
IF $TEST=0
WRITE !,?5,$CHAR(7),"Someone else is Editing this entry!"
GOTO EXIT
+9 SET DIE=DIC
SET (RMPRDA,DA)=+Y
+10 SET R1(0)=$GET(^RMPR(660,RMPRDA,0))
SET R1(1)=$GET(^(1))
SET R1("AM")=$GET(^("AM"))
+11 SET RMTOTCOS=$PIECE(R1(0),U,16)
+12 ;
+13 SET DR="7;5;14"
DO ^DIE
+14 IF RMTOTCOS'=$PIECE(^RMPR(660,DA,0),U,16)
SET DR="35////^S X=DUZ;36////^S X=DT"
DO ^DIE
+15 IF $DATA(DTOUT)!('$GET(Y))!($DATA(DUOUT))
+16 LOCK -^RMPR(660,RMPRDA,0)
+17 KILL DIR
WRITE !
SET DIR(0)="Y"
SET DIR("A")="Would You like to Edit another Entry (Y/N) "
DO ^DIR
+18 if '$DATA(DTOUT)&(Y>0)
GOTO RMPRE29C
EXIT ;
+1 NEW RMPR,RMPRSITE
DO KILL^XUSCLEAN
+2 KILL DIC,DIE,DIR,%,X,Y
+3 QUIT
