source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCEFIS5.m@ 1520

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

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1PRCEFIS5 ;WISC/CTB/CLH-DISPLAY 1358 TRANSACTIONS ; 05/19/94 9:22 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 N PO,PODA,PRCFA
5 I '$D(PRC("SITE")) N PRC,% S PRCF("X")="AS" D ^PRCFSITE Q:'%
6EN1 N Y,DIR,PRCFAUTH,ZTSAVE,ZTRTN,ZTDESC
7 D HILO^PRCFQ
8 I '$D(PO(0)) N PODA D OBLK^PRCH58OB(.PODA) Q:'PODA D PO^PRCH58OB(PODA,.PO) Q:$G(PO(0))="" S PRCFA("PODA")=PODA
9 S DIR("A")="Do you wish to view the Authorization information",DIR("B")="No",DIR(0)="YO",DIR("?")="Enter YES to view authorization information" D ^DIR Q:Y["^" K DIR S:Y=1 PRCFAUTH=""
10 S ZTSAVE("PO*")="",ZTSAVE("PR*")="",ZTSAVE("PRCFAUTH")="",ZTDESC="DISPLAY 1358 "_$P(PO(0),"^"),ZTRTN="Q^PRCEFIS5" D ^PRCFQ
11 Q
12 ;
13Q ;Entry point for queued report
14 N %X,AUTHAMT,C,CT,DATE,DIC,DREC,I,LIQAMT,OBNUM,S,TMP,UL,UT,X,X1,Z,ZX,DIR
15 S $P(UL,"_",80)="",OBNUM=$S($D(PO(0)):$P(PO(0),U),$D(PRCFA("PODA")):$P(^PRC(442,PRCFA("PODA"),0),U),1:"")
16 I '$D(DA) S DA=$S($D(PO(0)):+$P(PO(0),U,12),$D(PRCFA("PODA")):$P(^PRC(442,PRCFA("PODA"),0),U,12),1:0)
17 D HDR
18 I 'OBNUM!('$D(^PRC(424,"AD",OBNUM))) W !,"Daily Record entries have not yet been entered for this request.",!,"The total committed cost of this request is $" W $S($D(^PRCS(410,DA,4)):$J($P(^(4),U),0,2),1:0),!,UL D:'$D(ZTQUEUED) PAUSE^PRCFQ Q
19 S %=1,(X1,CT,UT)="" F S X1=$O(^PRC(424,"AD",OBNUM,X1)) Q:X1'>0 I $D(^PRC(424,X1,0)) S DREC=^(0) D I ($G(IOSL)-$Y<4) D:'$D(ZTQUEUED) PAUSE^PRCFQ Q:'% D HDR
20 . I '$D(PRCFAUTH),$P(DREC,U,3)="AU" Q
21 . S S="|",X=$P(DREC,U,7) D CNVD^PRCFQ S DATE=Y S TYPE=$P(DREC,U,3)
22 . I TYPE="" Q
23 . S AUTHAMT=$S(TYPE="AU":-$P(DREC,U,12),TYPE="O":$P(DREC,U,6),TYPE="A":$P(DREC,U,6),1:"")
24 . S LIQAMT=$S(TYPE="L":-$P(DREC,U,4),TYPE="O":$P(DREC,U,6),TYPE="A":$P(DREC,U,6),1:"")
25 . W !,DATE,?16,S," ",$S(TYPE="O":"OBLIGATION",TYPE="A":"ADJUSTMENT",1:$E($P(DREC,U,10),1,12)),?30,S
26 . I AUTHAMT]"",$D(PRCFAUTH) W $J(AUTHAMT,11,2),?42,S S CT=CT+AUTHAMT W $J(CT,11,2),?54,S
27 . E W ?42,S,?54,S
28 . I LIQAMT]"" W $J(LIQAMT,12,2),?67,S S UT=UT+LIQAMT W $J(UT,11,2)
29 . E W ?67,S
30 . K LIQAMT,AUTHAMT,ADJAMT,X,DREC,DATE,TYPE,Y
31 W !,UL D:'$D(ZTQUEUED) PAUSE^PRCFQ
32 Q
33 ;
34HDR W @IOF W ?25,"Obligation #: ",IOINHI,$P(PO(0),"^"),IOINORM
35 I $D(PO(8)) W !?$X+4,"Total Authorization:",IOINHI," $ "_$J($FN($P(PO(8),U,3),",",2),12),?$X+5,IOINORM,"Total Liquidation:",IOINHI," $ "_$J($FN($P(PO(8),U,2),",",2),12),IOINORM
36 W !?30,"|AUTHORIZATION/ORDER REC|",?59,"LIQUIDATION RECORD"
37 W !,?2,"Date/Time",?18,"Reference No",?30,"|Indiv/Daily",?48,"Cumul",?54,"| Liq. Amt",?67,"| Unliq Bal." W !,UL
38 Q
Note: See TracBrowser for help on using the repository browser.