57 lines
2.1 KiB
Mathematica
57 lines
2.1 KiB
Mathematica
RMPROP ;PHX/RFM,JLT,RVD-PURCHASING OPTIONS ;8/29/1994
|
|
;;3.0;PROSTHETICS;**41,45,53,62,61**;Feb 09, 1996
|
|
;
|
|
;RVD patch #53 only issue stock items from PIP
|
|
;
|
|
;RVD patch #62 pce interface, delete transaction if 2319 is deleted.
|
|
;
|
|
;RVD patch #61 PIP new files.
|
|
;
|
|
EN1 ;EACH OF THE BELOW ENTRY POINTS SETS THE FORM TYPE, SITE PARAMETERS
|
|
;AND CALLS THE ROUTINE FOR PURCHASING TRANSACTIONS
|
|
S RMPRF=1 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 G EXIT
|
|
;
|
|
EN2 ;Create 10-2421
|
|
S RMPRF=2 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 G EXIT
|
|
;
|
|
EN3 ;2520 Transaction without printing
|
|
S RMPRF=10 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 K RMPRAMT G EXIT
|
|
;
|
|
EN4 ;2914 EYEGLASS RECORD
|
|
;SETS FORM TYPE CODE FOR 2914
|
|
;VARIABLES REQUIRED: NONE
|
|
S RMPRF=8 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 G EXIT
|
|
;
|
|
EN5 ;CLOSE-OUT
|
|
S RMPRF="E" D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPRE21 G EXIT
|
|
;
|
|
EN6 ;NO-FORM DAILY RECORD
|
|
S RMPRF=9 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 G EXIT
|
|
;
|
|
EN7 ;ISSUE FROM STOCK
|
|
K RMPRDFN,RMPR
|
|
;patch #61 call rmprpiyi instead of rmprsti
|
|
S RMPRF=11 D ^RMPRPIYI G EXIT
|
|
;
|
|
EN9 ;PICKUP AND DELIVERY
|
|
D DIV4^RMPRSIT G:$D(X) EXIT S RMPRF=1 D EN^RMPRDP G EXIT
|
|
;
|
|
EN10 ;Edit 2319 Entry
|
|
S RMPREDT=1 ;set flag for the edit
|
|
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)="""")"
|
|
S DIC("W")="D EN^RMPRD1",DIC="^RMPR(660,",DIC(0)="AEQMZ",DIC("A")="Please Enter the 2319 Date or the Patient's Name: "
|
|
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
|
|
S (RMPRDA,DA)=+Y,DIE=DIC D TYP1^RMPRE29 K DIR
|
|
W ! S DIR(0)="Y",DIR("A")="Would You like to Delete this 2319 Entry (Y/N)" D ^DIR
|
|
I '$D(DTOUT)&(Y>0) D
|
|
.;added by patch #62.
|
|
.I $D(^RMPR(660,RMPRDA,10)),$P(^RMPR(660,RMPRDA,10),U,12) D
|
|
..S RMCHK=$$DEL^RMPRPCED(RMPRDA)
|
|
.S DA=RMPRDA,DIK="^RMPR(660," D ^DIK
|
|
L -^RMPR(660,RMPRDA,0)
|
|
W ! S DIR(0)="Y",DIR("A")="Would You like to Edit another Entry (Y/N)" D ^DIR
|
|
G:'$D(DTOUT)&(Y>0) EN10
|
|
EXIT K I,%,DA,DIE,DIK,DR,J,X,Y,RMPRF,DIC,DIR
|
|
N RMPR,RMPRSITE D KILL^XUSCLEAN Q
|