| [613] | 1 | RMPROP ;PHX/RFM,JLT,RVD-PURCHASING OPTIONS ;8/29/1994
|
|---|
| 2 | ;;3.0;PROSTHETICS;**41,45,53,62,61**;Feb 09, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | ;RVD patch #53 only issue stock items from PIP
|
|---|
| 5 | ;
|
|---|
| 6 | ;RVD patch #62 pce interface, delete transaction if 2319 is deleted.
|
|---|
| 7 | ;
|
|---|
| 8 | ;RVD patch #61 PIP new files.
|
|---|
| 9 | ;
|
|---|
| 10 | EN1 ;EACH OF THE BELOW ENTRY POINTS SETS THE FORM TYPE, SITE PARAMETERS
|
|---|
| 11 | ;AND CALLS THE ROUTINE FOR PURCHASING TRANSACTIONS
|
|---|
| 12 | S RMPRF=1 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 G EXIT
|
|---|
| 13 | ;
|
|---|
| 14 | EN2 ;Create 10-2421
|
|---|
| 15 | S RMPRF=2 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 G EXIT
|
|---|
| 16 | ;
|
|---|
| 17 | EN3 ;2520 Transaction without printing
|
|---|
| 18 | S RMPRF=10 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 K RMPRAMT G EXIT
|
|---|
| 19 | ;
|
|---|
| 20 | EN4 ;2914 EYEGLASS RECORD
|
|---|
| 21 | ;SETS FORM TYPE CODE FOR 2914
|
|---|
| 22 | ;VARIABLES REQUIRED: NONE
|
|---|
| 23 | S RMPRF=8 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 G EXIT
|
|---|
| 24 | ;
|
|---|
| 25 | EN5 ;CLOSE-OUT
|
|---|
| 26 | S RMPRF="E" D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPRE21 G EXIT
|
|---|
| 27 | ;
|
|---|
| 28 | EN6 ;NO-FORM DAILY RECORD
|
|---|
| 29 | S RMPRF=9 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 G EXIT
|
|---|
| 30 | ;
|
|---|
| 31 | EN7 ;ISSUE FROM STOCK
|
|---|
| 32 | K RMPRDFN,RMPR
|
|---|
| 33 | ;patch #61 call rmprpiyi instead of rmprsti
|
|---|
| 34 | S RMPRF=11 D ^RMPRPIYI G EXIT
|
|---|
| 35 | ;
|
|---|
| 36 | EN9 ;PICKUP AND DELIVERY
|
|---|
| 37 | D DIV4^RMPRSIT G:$D(X) EXIT S RMPRF=1 D EN^RMPRDP G EXIT
|
|---|
| 38 | ;
|
|---|
| 39 | EN10 ;Edit 2319 Entry
|
|---|
| 40 | S RMPREDT=1 ;set flag for the edit
|
|---|
| 41 | D DIV4^RMPRSIT G:$D(X) EXIT S DIC("S")="I $P(^(0),U,13)=3,$P(^(0),U,10)=RMPR(""STA"")" I RMPRSITE=1 S DIC("S")=DIC("S")_"!($P(^(0),U,10)="""")"
|
|---|
| 42 | S DIC("W")="D EN^RMPRD1",DIC="^RMPR(660,",DIC(0)="AEQMZ",DIC("A")="Please Enter the 2319 Date or the Patient's Name: "
|
|---|
| 43 | 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
|
|---|
| 44 | ;S (RMPRDA,DA)=+Y,DIE=DIC,DR="[RMPRE2319]" D ^DIE
|
|---|
| 45 | S (RMPRDA,DA)=+Y,DIE=DIC D TYP1^RMPRE29 K DIR
|
|---|
| 46 | W ! S DIR(0)="Y",DIR("A")="Would You like to Delete this 2319 Entry (Y/N)" D ^DIR
|
|---|
| 47 | I '$D(DTOUT)&(Y>0) D
|
|---|
| 48 | .;added by patch #62.
|
|---|
| 49 | .I $D(^RMPR(660,RMPRDA,10)),$P(^RMPR(660,RMPRDA,10),U,12) D
|
|---|
| 50 | ..S RMCHK=$$DEL^RMPRPCED(RMPRDA)
|
|---|
| 51 | .S DA=RMPRDA,DIK="^RMPR(660," D ^DIK
|
|---|
| 52 | L -^RMPR(660,RMPRDA,0)
|
|---|
| 53 | W ! S DIR(0)="Y",DIR("A")="Would You like to Edit another Entry (Y/N)" D ^DIR
|
|---|
| 54 | G:'$D(DTOUT)&(Y>0) EN10
|
|---|
| 55 | EXIT K I,%,DA,DIE,DIK,DR,J,X,Y,RMPRF,DIC,DIR
|
|---|
| 56 | N RMPR,RMPRSITE D KILL^XUSCLEAN Q
|
|---|
