source: WorldVistAEHR/trunk/r/EQUIPMENT_TURN_IN_REQUEST-PRCN/PRCNEQAP.m@ 691

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

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1PRCNEQAP ;SSI/ALA-Equipment Committee Approval ;[ 09/11/96 1:59 PM ]
2 ;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
3EN ;Ask for approval type
4 S DIR("A")="Select Approval Methodology"
5 S DIR("A",2)=" "
6 S DIR("A",1)="Select the appropriate approval methodology to process multiple transactions."
7 S DIR("A",3)="Option 1 - APPROVE/FUNDED ALL LINE ITEMS should be used when all line items in a"
8 S DIR("A",4)="transaction have been designated 'approve and funded' and are ready for 2237"
9 S DIR("A",5)="processing."
10 S DIR("A",6)="Option 2 - APPROVE/PENDING ALL LINE ITEMS should be used when all line items"
11 S DIR("A",7)="in a transaction have been approved but funding is still pending."
12 S DIR("A",8)="Option 3 - DISAPPROVE ALL LINE ITEMS should be used when all lines items in a"
13 S DIR("A",9)="transaction have not been approved."
14 S DIR("A",10)="Option 4 - DEFER ALL LINE ITEMS should be used when all line items in a"
15 S DIR("A",11)="transaction should be deferred until a later decision cycle."
16 S DIR("A",12)="Option 5 - Process Individual Line Items should be used when some line items"
17 S DIR("A",13)="in the same transaction have been approved and some have not been approved."
18 S DIR("A",14)=" "
19 S DIR(0)="S^1:APPROVE/FUNDED ALL LINE ITEMS;2:APPROVE/PENDING ALL LINE ITEMS;3:DISAPPROVE ALL LINE ITEMS;4:DEFER ALL LINE ITEMS;5:PROCESS INDIVIDUAL LINE ITEMS"
20 D ^DIR G EXIT:$G(DIRUT)=1 S EQXI=X,EQXT=Y(0)
21BEG ;
22 D ^PRCNEQA2 G EXIT:$G(DIRUT)=1!($G(VTI)="^")
23 S STAT=$S(EQXI=1:19,EQXI=2:18,EQXI=3:16,EQXI=4:17,1:"")
24 S STT=$S(EQXI=1:"AF",EQXI=2:"AP",EQXI=3:"DD",EQXI=4:"DF",1:"")
25 S MSGN=$S(EQXI=1:43,EQXI=2:44,EQXI=3:40,EQXI=4:39,1:"")
26 S IN="" F S IN=$O(^TMP($J,"APP","D",IN)) Q:IN="" D I $G(DUOUT)=1 S DUOUT=0 G BEG
27 . I EQXI<5 D FAP^PRCNEQA1 Q:$G(DUOUT)=1
28 . I EQXI=5 D LINE^PRCNEQA1 Q:$G(DUOUT)=1!($G(DTOUT)=1) D ^PRCNEQS
29 . I $G(IN)'="" S PSER="" F S PSER=$O(^PRCN(413,"P",PSER)) Q:PSER="" D
30 .. S RNK="" F S RNK=$O(^PRCN(413,"P",PSER,RNK)) Q:RNK="" K ^PRCN(413,"P",PSER,RNK,IN)
31 . K PSER,X,RNK
32EXIT K DIR,DIRUT,LTOTAL,PN,PRCNT,PRCNZ,SERV,TOTAL,TQTY,XX,PRCNZ,PRCNT,Y
33 K ^TMP($J),EQXI,EQXT,EQLS,PRCNI,PRCNJ,PRCNK,PRCNN,PRCNT,PRCNL,SK,NTRN
34 K ER,FN,IN,IN2,MSGN,STAT,STT,COST,D0,D1,I,PRCNX,D,DA,EQDA,J,LBN,LPRI
35 K OLDPRI,PRIMAX,X,XMDT
36 Q
37HDR(X) ; Prints NX header and up to 18 lines of NX data
38 D:'$D(IOF) HOME^%ZIS
39 W @IOF,?15,EQXT_" in the following Equipment Requests",!!
40 W !,"Num#",?7,"Rank",?13,"Request #",?33,"Service",?60,"# Items",?70,"Amount",!
41 F I=1:1:79 W "-"
42 F Y=X:1:X+17 Q:'$D(^TMP($J,"APP",Y)) S D0=^TMP($J,"APP",Y) D
43 . D GETSUMS W !,Y,?7,$P($G(^PRCN(413,D0,6)),U,3)
44 . W ?13,$P($G(^PRCN(413,D0,0)),U) S SERV=$P(^DIC(49,$P(^(0),U,3),0),U)
45 . W ?33,$E(SERV,1,25),?62,TQTY,?70,"$",$J(TOTAL,8,2)
46 Q
47GETSUMS ; Get line item total & display stuff
48 S (D1,TQTY,TOTAL,LTOTAL)=0 NEW Y
49 F S D1=$O(^PRCN(413,D0,1,D1)) Q:'+D1 D S TQTY=TQTY+1
50 . S DR=15,DR(413.015)=6,DIQ(0)="C",DIQ="LBTOT"
51 . S DIC=413,DA=D0,DA(1)=D1,DA(413.015)=D1 NEW D1
52 . D EN^DIQ1
53 . S LBN="" F S LBN=$O(LBTOT(413.015,LBN)) Q:LBN="" D
54 .. S X=$G(LBTOT(413.015,LBN,6))
55 .. S LTOTAL=LTOTAL+X
56 . K DR,DIQ,LBTOT,DIC,X
57 S TOTAL=TOTAL+LTOTAL F FN=20,22,24,53,54,60,63,65,66 D
58 . S:FN<25 I=2,PN=FN-15 S:FN>25 I=7,PN=FN-51
59 . S COST=$P($G(^PRCN(413,D0,I)),U,PN),TOTAL=TOTAL+COST
60 Q
Note: See TracBrowser for help on using the repository browser.