- 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 Feb 19, 2025@00:00:44 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