RMPRE29C.m

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 ---RMPRE29C   956     printed  Apr 09, 2024@21:35:35                                                                                                                                                                                                     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