Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPROP

RMPROP.m

Go to the documentation of this file.
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