| 1 | PRCNEQA2 ;SSI/ALA-Equipment Committee Approval ;[ 09/11/96 2:01 PM ]
|
|---|
| 2 | ;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
|
|---|
| 3 | BEG K DIR,Y,^TMP($J,"APP") S PRCNX=0,PRCNT=0,PRCNZ=-17,PG=1
|
|---|
| 4 | BLST ; 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
|
|---|
| 10 | BPRT ; Update display number and print a screenful
|
|---|
| 11 | S NPG=PG,PG=1
|
|---|
| 12 | BLP ; 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)=""
|
|---|
| 18 | SEL 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
|
|---|
| 26 | SEL1 ;
|
|---|
| 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
|
|---|
| 34 | HDR ; 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
|
|---|
| 44 | GETSUMS ; 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
|
|---|
