Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACGSCPAR

ACGSCPAR.m

Go to the documentation of this file. 
  1. ACGSCPAR ;IHS/OIRM/DSD/THL,AEF - UTILITY TO PRINT THE COMPETITIVE PROCUREMENT ACTIVITY REPORT; [ 03/27/2000   2:22 PM ]
  1.  ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
  1.  ;;UTILITY TO PRINT THE COMPETITIVE PROCUREMENT ACTIVITY REPORT
  1.  ;;modified for y2k;mlp;01/31/2000
  1. EN S:'$D(ACGPARA) ACGPARA=^ACGPARA(ACGPODA,0),ACG4=$P(ACGPARA,U,3)
  1.  D EN1
  1. EXIT K ACG,ACG1,ACG4,ACG4X,ACG19,ACG26,ACG27,ACGFY,ACGQT,ACGT,ACGX,ACGQIT,ACGTODAY,ACGBEG,ACGBEGIN,ACGEND,ACGRDA,ZTRTN,ZTDESC,ACGQUIT
  1.  Q
  1. EN1 K ACGQUIT
  1.  D QT
  1.  I $D(ACGQUIT) K ACGQUIT Q
  1.  I ACG4=236 D CO Q:$D(ACGQUIT)  I 1
  1.  E  S (ACG4,ACG4X)=ACG4
  1. ZIS S ZTRTN="REPORT^ACGSCPAR",ZTDESC="COMP. PROCUREMENT ACT. REPORT"
  1.  D ^ACGSZIS
  1.  Q:$D(ACGQUIT)
  1. REPORT I '$D(ZTQUEUED) S (ACGIOP,IOP)=ION D ^%ZIS I POP S ACGQUIT="" Q
  1.  U IO
  1.  I ACG4X=88 F ACG4=102,121,161,235,239,241:1:249,284,285 K ACGQUIT D R1
  1.  G:ACG4X=88 DONE
  1. R1 G:$D(ACGQUIT) DONE
  1.  D BEGIN,HEAD,^ACGSCPA1
  1.  W:$D(IOF) @IOF
  1.  D:ACG4X'=88 DONE
  1.  Q
  1. DONE D DONE^ACGSZIS
  1.  Q
  1.  W:$D(IOF) @IOF
  1.  S ACGT="ACGT("_ACG4_")"
  1.  S Y=DT X ^DD("DD") S ACGTODAY=Y
  1.  W !?20,"COMPETITIVE PROCUREMENT ACTIVITY REPORT",!!,"PERIOD BEGINNING DATE: ",$E(ACGBEGIN,2,7),!,"PERIOD ENDING DATE...: ",$E(ACGEND,2,7),!,"CURRENT DATE.........: ",ACGTODAY,!,"PROCURING ACTIVITY...: "
  1. TEMP W $S($D(^ACGPO("C",ACG4)):ACG4_" "_$P(^ACGPO($O(^ACGPO("C",ACG4,0)),0),U),1:"COMBINED REPORT")
  1.  W !!,"     (1)      |    (2)     |    (3)     |    (4)     |    (5)     |    (6)"
  1.  W !,"     P.L.     |    BUY     |   SB/LSA   |    8(A)    |    ALL     |"
  1.  W !,"    93-638    |   INDIAN   | SET ASIDES |   AWARD    |   OTHERS   |   TOTALS"
  1.  W !,"--------------|------------|------------|------------|------------|-------------"
  1.  W !," NO.          | NO.        | NO.        | NO.        | NO.        | NO."
  1.  W !,"      AMOUNT  |    AMOUNT  |    AMOUNT  |    AMOUNT  |    AMOUNT  |   AMOUNT"
  1.  W !,"--------------|------------|------------|------------|------------|-------------"
  1.  Q
  1. BEGIN K ACGT
  1.  F ACG=50,56,58:1:63 F ACG1="C","M","O","T","Q" S ACGT(ACG4,ACG,ACG1)=0
  1.  F ACG="CCT","CMT","COT","CT","NCCT","NCMT","NCOT","NCT","T","Q" S ACGT(ACG4,ACG)=0
  1.  S ACGBEG=ACGBEGIN,ACG26X=0
  1.  F  S ACGBEG=$O(^ACGS("T",ACGBEG)) Q:'ACGBEG!(ACGBEG>ACGEND)  D B1
  1.  Q
  1. B1 S ACGRDA=0
  1.  F  S ACGRDA=$O(^ACGS("T",ACGBEG,ACGRDA)) Q:'ACGRDA  I $D(^ACGS(ACGRDA,"DT")),$D(^("DT1")) D
  1.  .I ACG4X'=99 Q:$P(^ACGS(ACGRDA,"DT"),U,4)'=ACG4
  1.  .S ACG1=$P(^ACGS(ACGRDA,"DT"),U),ACG19=$P(^("DT"),U,19),ACG26=$P(^("DT1"),U,5),ACG27=$P(^("DT1"),U,6),ACG26X=ACG26X+ACG26
  1.  .Q:'ACG1
  1.  .Q:ACG1=15!(ACG1=17)
  1.  .I 'ACG19 S ACG19=56
  1.  .S ACG19=$S(ACG19<56:50,ACG19=56!(ACG19=57):56,1:ACG19),ACG27=$S(ACG27:$P(^ACGPPC(ACG27,0),U),1:""),ACG1=$P(^ACGTPA(ACG1,0),U),ACG1=$S("DIA"[$E(ACG1):"C","RCM"[$E(ACG1):"M",1:"O")
  1.  .S ACGX=$S(ACG19<60:"C",1:"NC")_ACG1_"T",ACG=$S(ACG19<60:"C",1:"NC")_"T" F ACG=ACG,ACGX,"T" S $P(ACGT(ACG4,ACG),U)=$P(ACGT(ACG4,ACG),U)+ACG26,$P(ACGT(ACG4,ACG),U,2)=$P(ACGT(ACG4,ACG),U,2)+1
  1.  .I $E(ACG27)="Q" S ACG="Q",$P(ACGT(ACG4,ACG),U)=$P(ACGT(ACG4,ACG),U)+ACG26,$P(ACGT(ACG4,ACG),U,2)=$P(ACGT(ACG4,ACG),U,2)+1
  1.  .S:$E(ACG27)="Q" $P(ACGT(ACG4,ACG19,"Q"),U)=$P(ACGT(ACG4,ACG19,"Q"),U)+ACG26,$P(ACGT(ACG4,ACG19,"Q"),U,2)=$P(ACGT(ACG4,ACG19,"Q"),U,2)+1
  1.  .F ACG1=ACG1,"T" S $P(ACGT(ACG4,ACG19,ACG1),U)=$P(ACGT(ACG4,ACG19,ACG1),U)+ACG26,$P(ACGT(ACG4,ACG19,ACG1),U,2)=$P(ACGT(ACG4,ACG19,ACG1),U,2)+1
  1.  Q
  1. QT ;EP;TO DETERMINE DATE RANGE FOR QUARTERS
  1.  S DIR(0)="SO^1:FIRST;2:SECOND;3:THIRD;4:FOURTH;5:YEAR-TO-DATE",DIR("A")="Quarter....",DIR("?")="Enter the quarter for the report"
  1.  W !
  1.  D DIR^ACGSDIC
  1.  Q:$D(ACGQUIT)
  1.  S ACGQT=+Y
  1.  I ACGQT=5 S ACGQTX=5,ACGQT=1
  1.  D FY^ACGSEXP
  1.  I $D(ACGQTX) S ACGQT=5 K ACGQTX
  1.  Q:$D(ACGQUIT)
  1. PERIOD S:ACGQT=1!(ACGQT=5) ACGFY=ACGFY-1
  1.  ;S ACGBEGIN=2_ACGFY_$S(ACGQT=1!(ACGQT=5):10,ACGQT=2:"01",ACGQT=3:"04",1:"07")_"01",ACGEND=2_ACGFY_$S(ACGQT=1:12,ACGQT=2:"03",ACGQT=3:"06",1:"09")_$S(ACGQT<3:31,1:30),ACGBEGIN=ACGBEGIN-1
  1.  S ACGBEGIN=ACGFY_$S(ACGQT=1!(ACGQT=5):10,ACGQT=2:"01",ACGQT=3:"04",1:"07")_"01",ACGEND=ACGFY_$S(ACGQT=1:12,ACGQT=2:"03",ACGQT=3:"06",1:"09")_$S(ACGQT<3:31,1:30),ACGBEGIN=ACGBEGIN-1 ;y2k;mlp
  1.  ;S:ACGQT=5 ACGEND=2_(ACGFY+1)_"0930"
  1.  S:ACGQT=5 ACGEND=(ACGFY+1)_"0930" ;y2k;mlp
  1.  Q
  1. CO ;EP
  1.  S DIR(0)="SO^102:OES Seattle;121:OES New York;161:OES Dallas;235:California;236:Headquarters;239:Bemidji;241:Aberdeen;242:Albuquerque;243:Alaska;244:Billings;245:Navajo;246:Oklahoma;247:Phoenix;248:Portland;249:Tucson"
  1.  S DIR(0)=DIR(0)_";284:Perry Point;285:Nashville;88:Each Office;99:Summary Report",DIR("A")="Contracting Office",DIR("?")="Enter the number of the Contracting office"
  1.  D DIR^ACGSDIC
  1.  Q:$D(ACGQUIT)
  1.  S (ACG4X,ACG4)=+Y
  1.  Q
  1. DIR D ^DIR S:$D(DIRUT) ACGQUIT="" K DIR,DIRUT,DUOUT,DTOUT Q
  1.  ;