source: FOIAVistA/trunk/r/EQUIPMENT_TURN_IN_REQUEST-PRCN/PRCNEQA2.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1PRCNEQA2 ;SSI/ALA-Equipment Committee Approval ;[ 09/11/96 2:01 PM ]
2 ;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
3BEG K DIR,Y,^TMP($J,"APP") S PRCNX=0,PRCNT=0,PRCNZ=-17,PG=1
4BLST ; Build list of Equipment Requests
5 S PRCNX=$O(^PRCN(413,PRCNX)) G:PRCNX'>0 BPRT
6 I $P(^PRCN(413,PRCNX,0),U,7)=31 D
7 . S PRCNT=PRCNT+1,^TMP($J,"APP",PG,PRCNT)=PRCNX
8 . I PRCNT=12 S PG=PG+1
9 G BLST
10BPRT ; Update display number and print a screenful
11 S NPG=PG,PG=1
12BLP ; Main loop: get input & process help
13 D HDR
14 I PRCNT=0 D Q
15 . W !!,"NO RECORDS TO PROCESS"
16 . R !!,"Press return to continue: ",PRCNX:DTIME
17 K ^TMP($J,"APP","D"),DUOUT S X=0,ER=0,ER(0)=""
18SEL I NPG>1 S DIR(0)="SM^S:Select Requests;N:Next Page;P:Previous Page"
19 I NPG=1 G SEL1
20 S DIR("A")="Select Action "
21 D ^DIR K DIR S VTI=$$UP^XLFSTR(X) I VTI["^" Q
22 I VTI="N",PG+1>NPG W !,"No Next Page" G SEL
23 I VTI="P",PG-1<1 W !,"No Previous Page" G SEL
24 I VTI="N" S PG=PG+1 G BLP
25 I VTI="P" S PG=PG-1 G BLP
26SEL1 ;
27 S DIR("A")="Select numbers to process",DIR(0)="L^1:"_PRCNT
28 D ^DIR Q:$G(DIRUT)=1 S EQLS=Y K DIR,Y,X
29 F J=1:1 S EQDA=$P(EQLS,",",J) Q:EQDA="" D
30 . S PPG="" F S PPG=$O(^TMP($J,"APP",PPG)) Q:PPG="" D
31 .. Q:$G(^TMP($J,"APP",PPG,EQDA))=""
32 .. S ^TMP($J,"APP","D",^TMP($J,"APP",PPG,EQDA))=""
33 Q
34HDR ; Prints NX header and up to 12 lines of NX data
35 D:'$D(IOF) HOME^%ZIS
36 W @IOF,?15,EQXT_" in the following Equipment Requests",!
37 W !,"Num#",?7,"Rank",?13,"Request #",?33,"Service",?60,"# Items",?70,"Amount",!
38 F I=1:1:79 W "-"
39 S Y="" F S Y=$O(^TMP($J,"APP",PG,Y)) Q:Y="" S D0=^TMP($J,"APP",PG,Y) D
40 . D GETSUMS W !,Y,?7,$P($G(^PRCN(413,D0,6)),U,3)
41 . W ?13,$P($G(^PRCN(413,D0,0)),U) S SERV=$P(^DIC(49,$P(^(0),U,3),0),U)
42 . W ?33,$E(SERV,1,25),?62,TQTY,?70,"$",$J(TOTAL,8,2)
43 Q
44GETSUMS ; Get line item total & display stuff
45 S (D1,TQTY,TOTAL,LTOTAL)=0 NEW Y
46 F S D1=$O(^PRCN(413,D0,1,D1)) Q:'+D1 D S TQTY=TQTY+1
47 . S DR=15,DR(413.015)=6,DIQ(0)="C",DIQ="LBTOT"
48 . S DIC=413,DA=D0,DA(1)=D1,DA(413.015)=D1 NEW D1
49 . D EN^DIQ1
50 . S LBN="" F S LBN=$O(LBTOT(413.015,LBN)) Q:LBN="" D
51 .. S X=$G(LBTOT(413.015,LBN,6))
52 .. S LTOTAL=LTOTAL+X
53 . K DR,DIQ,LBTOT,DIC,X
54 S TOTAL=TOTAL+LTOTAL F FN=20,22,24,53,54,60,63,65,66 D
55 . S:FN<25 I=2,PN=FN-15 S:FN>25 I=7,PN=FN-51
56 . S COST=$P($G(^PRCN(413,D0,I)),U,PN),TOTAL=TOTAL+COST
57 Q
Note: See TracBrowser for help on using the repository browser.