source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRP2.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1RMPRP2 ;PHX/JLT-APPROVE PURCHASE REQUESTS ;10/01/1994
2 ;;3.0;PROSTHETICS;;Feb 09, 1996
3ASK ;ASK FOR MUTLIPLE ASSGIN
4 K RMPRSNG D DIV4^RMPRSIT G:$D(X) EXIT
5 K RMPRSBP D AP^RMPRSEC G:$G(X1)="" EXIT S RMPRESIG=X1
6 I $G(RMPRX)="^" K RMPRX G EXIT
7 S DIR(0)="Y",DIR("A")="Would you like Approve Multiple Purchases",DIR("B")="YES" D ^DIR G:$D(DIRUT)!($D(DTOUT)) EXIT I +Y=1 D MUTL G EXIT
8SIG ;SINGEL APPROVE
9 S RMPRSNG=1,DIC(0)="AEQMZ",DIC("W")="D EN2^RMPRD1",DIC="^RMPR(664,",DIC("S")="I $P($G(^RMPR(664,+Y,4)),U,8)=1" D ^DIC G:+Y'>0 EXIT S RMPRDA=+Y
10DSP ;DISPLAY PURCHASE INFO
11 S IOP="HOME",(FR,TO)=RMPRDA,BY="@NUMBER",DIC="^RMPR(664,",L=0,FLDS="[RMPR APPROVE]" D EN1^DIP
12APP ;APPROVE REQUEST
13 I $Y<19 F W ! Q:$Y>19
14 K DIR,Y,DA S DIR(0)="Y",DIR("A")="Would you like to Approve this Request" D ^DIR I $D(DIRUT)!($D(DTOUT))!(+Y=0) W !!,?5,$C(7),"Request not Approved" H 2 G:$D(RMPRSNG) SIG
15 I +Y=1 D SGN G:$D(RMPRSNG) SIG
16 I +Y["^" K RMPRDA
17 Q
18SGN S $P(^RMPR(664,RMPRDA,4),U,3)=DUZ,$P(^(4),U,4)=RMPRSBT
19 S $P(^RMPR(664,RMPRDA,4),U,7)=$$SUM^RMPRSEC(RMPRSBP),$P(^RMPR(664,RMPRDA,4),U,6)=$$ENCODE^RMPRSEC(RMPRSBP,DUZ,1),$P(^RMPR(664,RMPRDA,4),U,5)=DT
20 K ^RMPR(664,"AP",RMPR("STA"),$P($G(^RMPR(664,RMPRDA,4)),U,9),RMPRDA)
21 S $P(^RMPR(664,RMPRDA,4),U,8)=""
22 Q
23EXIT N RMPR,RMPRSITE D KILL^XUSCLEAN Q
24MUTL ;APPROVE MULTIPLE REQUESTS
25 F RMPRDT=0:0 S RMPRDT=$O(^RMPR(664,"AP",RMPR("STA"),RMPRDT)) Q:$G(RMPRDT)'>0 S RMPRDA=0 F S RMPRDA=$O(^RMPR(664,"AP",RMPR("STA"),RMPRDT,RMPRDA)) Q:$G(RMPRDA)'>0 D DSP Q:$G(RMPRDA)'>0
26 Q
Note: See TracBrowser for help on using the repository browser.