| [613] | 1 | PRCHRPT2 ;SF/TKW-PRINT 1988 FPDS REPORTS ; 6/17/97 9:30 AM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;****NOTE: ALL OPTIONS EXCEPT EN5 ARE NO LONGER IN USE. ****
|
|---|
| 5 | ;
|
|---|
| 6 | EN1 Q S PRCHRPT=1,PRCHH1="FPDS LESS THAN 10K" G RANGE
|
|---|
| 7 | ;
|
|---|
| 8 | EN2 Q S PRCHRPT=2,PRCHH1="FPDS GREATER THAN 10K" G RANGE
|
|---|
| 9 | ;
|
|---|
| 10 | EN3 Q S PRCHRPT=3,PRCHH1="FPDS BY CONTRACT NO." G RANGE
|
|---|
| 11 | ;
|
|---|
| 12 | EN4 Q S PRCHRPT=4,PRCHH1="FPDS LINE-ITEM COUNT" G RANGE
|
|---|
| 13 | ;
|
|---|
| 14 | EN5 S PRCHRPT=5,PRCHH1="FUND CONTROL POINT" S PRCF("X")="SP" D ^PRCFSITE G RANGE
|
|---|
| 15 | ;
|
|---|
| 16 | RANGE Q:'$D(PRC("SITE")) W !!!,"PRINT REPORT OF "_PRCHH1
|
|---|
| 17 | S M="P.O.DATE",PRCHD="DATE" D RNG^PRCHRPT1 G:(FR["^")!(TO["^") EXIT I (FR["?")!(TO["?") D DSP G RANGE
|
|---|
| 18 | ;
|
|---|
| 19 | RANG2 K PRCHD I PRCHRPT=5 S PRCHSFR=FR,PRCHSTO=TO,M="FUND CONTROL POINT" D RNG^PRCHRPT1 G:(FR["^")!(TO["^") EXIT I (FR["?")!(TO["?") D DSP2 G RANG2
|
|---|
| 20 | I PRCHRPT=5 S PRCHFR=FR,PRCHTO=TO,FR=PRCHSFR,TO=PRCHSTO K PRCHSFR,PRCHSTO
|
|---|
| 21 | S ZTRTN="ENP^PRCHRPT2" D SDEV^PRCHRPT1 G:POP EXIT G:'$D(IO(0)) EXIT G:IO(0)=IO EXIT
|
|---|
| 22 | S M="print this report" D PDT^PRCHRPT1 G:X["^" EXIT
|
|---|
| 23 | S ZTDTH=PRCHPDAT,ZTDESC="Print "_PRCHH1
|
|---|
| 24 | K ZTSAVE S ZTSAVE("U")="",ZTSAVE("PRCHRPT")="",ZTSAVE("FR")="",ZTSAVE("TO")="",ZTSAVE("PRCHH1")="",ZTSAVE("PRC(""SITE"")")=""
|
|---|
| 25 | I PRCHRPT=5 S ZTSAVE("PRCHFR")="",ZTSAVE("PRCHTO")=""
|
|---|
| 26 | D ^%ZTLOAD K ZTRTN,ZTUCI,ZTDTH,ZTSAVE,ZTDESC,ZTSK,ZTSKT G EXIT
|
|---|
| 27 | ;
|
|---|
| 28 | DSP W !! W:FR["?" "TO SORT IN SEQUENCE , STARTING FROM A CERTAIN "_M_"," W:TO["?" "TO SORT ONLY UP TO A CERTAIN "_M_","
|
|---|
| 29 | W !,"TYPE THAT "_M,!,"'@' MEANS 'INCLUDE NULL "_M_" FIELDS'" Q
|
|---|
| 30 | ;
|
|---|
| 31 | DSP2 S DIC="^PRC(420,"_PRC("SITE")_",1,",DA(1)=PRC("SITE"),DIC(0)="QEMNZ",X="?" D ^DIC Q
|
|---|
| 32 | ;
|
|---|
| 33 | ENP ; ENTRY POINT FOR PRINTING FPDS REPORTS
|
|---|
| 34 | D NOW^%DTC S Y=% D DD^%DT K ^TMP($J) S PRCHPDAT=Y
|
|---|
| 35 | S PRCHPFR="FIRST DATE",PRCHPTO="LAST DATE" I +FR=FR S Y=FR D DD^%DT S PRCHPFR=Y
|
|---|
| 36 | I +TO=TO S Y=TO D DD^%DT S PRCHPTO=Y
|
|---|
| 37 | S PRCHPOR=0 D RD^PRCHRPT4,EN^PRCHRPT3
|
|---|
| 38 | W $C(13) D:$D(ZTSK) KILL^%ZTLOAD K ZTSK,ZTSKT
|
|---|
| 39 | G EXIT
|
|---|
| 40 | ;
|
|---|
| 41 | EXIT K %,%DT,%H,%ZIS,IO("Q"),IOP,I,J,K,M,N,DA,DIC,X,Y,ZTRTN,FR,TO,^TMP($J),PRCHH1,PRCHRPT,PRCHPFR,PRCHPTO
|
|---|
| 42 | K PRCHAMT,PRCHBOU2,PRCHBOUT,PRCHCON,PRCHDY,PRCHET,PRCHFR,PRCHH1,PRCHKEY,PRCHPAGE,PRCHFR
|
|---|
| 43 | K PRCHPONO,PRCHPOR,PRCHTO,PRCHRFLG,PRCHRPT,PRCHSFR,PRCHSPN,PRCHSTO,PRCHTO,PRCHTOT,PRCHTOTA,PRCHTOTL,PRCHTYP,PRCHTYPP,PRCHX,PRCHD,PRCHPDAT,PRCHPOD
|
|---|
| 44 | Q
|
|---|
