- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPROP 2205 printed Mar 13, 2025@21:40:17 Page 2
- RMPROP ;PHX/RFM,JLT,RVD-PURCHASING OPTIONS ;8/29/1994
- +1 ;;3.0;PROSTHETICS;**41,45,53,62,61**;Feb 09, 1996
- +2 ;
- +3 ;RVD patch #53 only issue stock items from PIP
- +4 ;
- +5 ;RVD patch #62 pce interface, delete transaction if 2319 is deleted.
- +6 ;
- +7 ;RVD patch #61 PIP new files.
- +8 ;
- EN1 ;EACH OF THE BELOW ENTRY POINTS SETS THE FORM TYPE, SITE PARAMETERS
- +1 ;AND CALLS THE ROUTINE FOR PURCHASING TRANSACTIONS
- +2 SET RMPRF=1
- DO DIV4^RMPRSIT
- if $DATA(X)
- GOTO EXIT
- DO ^RMPR21
- GOTO EXIT
- +3 ;
- EN2 ;Create 10-2421
- +1 SET RMPRF=2
- DO DIV4^RMPRSIT
- if $DATA(X)
- GOTO EXIT
- DO ^RMPR21
- GOTO EXIT
- +2 ;
- EN3 ;2520 Transaction without printing
- +1 SET RMPRF=10
- DO DIV4^RMPRSIT
- if $DATA(X)
- GOTO EXIT
- DO ^RMPR21
- KILL RMPRAMT
- GOTO EXIT
- +2 ;
- EN4 ;2914 EYEGLASS RECORD
- +1 ;SETS FORM TYPE CODE FOR 2914
- +2 ;VARIABLES REQUIRED: NONE
- +3 SET RMPRF=8
- DO DIV4^RMPRSIT
- if $DATA(X)
- GOTO EXIT
- DO ^RMPR21
- GOTO EXIT
- +4 ;
- EN5 ;CLOSE-OUT
- +1 SET RMPRF="E"
- DO DIV4^RMPRSIT
- if $DATA(X)
- GOTO EXIT
- DO ^RMPRE21
- GOTO EXIT
- +2 ;
- EN6 ;NO-FORM DAILY RECORD
- +1 SET RMPRF=9
- DO DIV4^RMPRSIT
- if $DATA(X)
- GOTO EXIT
- DO ^RMPR21
- GOTO EXIT
- +2 ;
- EN7 ;ISSUE FROM STOCK
- +1 KILL RMPRDFN,RMPR
- +2 ;patch #61 call rmprpiyi instead of rmprsti
- +3 SET RMPRF=11
- DO ^RMPRPIYI
- GOTO EXIT
- +4 ;
- EN9 ;PICKUP AND DELIVERY
- +1 DO DIV4^RMPRSIT
- if $DATA(X)
- GOTO EXIT
- SET RMPRF=1
- DO EN^RMPRDP
- GOTO EXIT
- +2 ;
- EN10 ;Edit 2319 Entry
- +1 ;set flag for the edit
- SET RMPREDT=1
- +2 DO DIV4^RMPRSIT
- if $DATA(X)
- GOTO EXIT
- SET DIC("S")="I $P(^(0),U,13)=3,$P(^(0),U,10)=RMPR(""STA"")"
- IF RMPRSITE=1
- SET DIC("S")=DIC("S")_"!($P(^(0),U,10)="""")"
- +3 SET DIC("W")="D EN^RMPRD1"
- SET DIC="^RMPR(660,"
- SET DIC(0)="AEQMZ"
- SET DIC("A")="Please Enter the 2319 Date or the Patient's Name: "
- +4 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
- +5 ;S (RMPRDA,DA)=+Y,DIE=DIC,DR="[RMPRE2319]" D ^DIE
- +6 SET (RMPRDA,DA)=+Y
- SET DIE=DIC
- DO TYP1^RMPRE29
- KILL DIR
- +7 WRITE !
- SET DIR(0)="Y"
- SET DIR("A")="Would You like to Delete this 2319 Entry (Y/N)"
- DO ^DIR
- +8 IF '$DATA(DTOUT)&(Y>0)
- Begin DoDot:1
- +9 ;added by patch #62.
- +10 IF $DATA(^RMPR(660,RMPRDA,10))
- IF $PIECE(^RMPR(660,RMPRDA,10),U,12)
- Begin DoDot:2
- +11 SET RMCHK=$$DEL^RMPRPCED(RMPRDA)
- End DoDot:2
- +12 SET DA=RMPRDA
- SET DIK="^RMPR(660,"
- DO ^DIK
- End DoDot:1
- +13 LOCK -^RMPR(660,RMPRDA,0)
- +14 WRITE !
- SET DIR(0)="Y"
- SET DIR("A")="Would You like to Edit another Entry (Y/N)"
- DO ^DIR
- +15 if '$DATA(DTOUT)&(Y>0)
- GOTO EN10
- EXIT KILL I,%,DA,DIE,DIK,DR,J,X,Y,RMPRF,DIC,DIR
- +1 NEW RMPR,RMPRSITE
- DO KILL^XUSCLEAN
- QUIT
