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

ACGS281.m

Go to the documentation of this file. 
  1. ACGS281 ;IHS/OIRM/DSD/THL,AEF - UTILITY TO PRINT THE SMALL PURCHASE 281 REPORT; [ 03/27/2000  5:49 PM ]
  1.  ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
  1.  ;;UTILITY TO PRINT THE SMALL PURCHASE 281 REPORT
  1.  ;;modfied for y2k;mlp;01/31/2000
  1. EN S:'$D(ACGPARA) ACGPARA=^ACGPARA(1,0)
  1.  D EN1
  1. EXIT K ACG,ACG1,ACG4XX,ACG4XX,ACG4XX,ACG19,ACG26,ACG27,ACGFY,ACGQT,ACGT,ACGX,ACGQIT,ACGTODAY,ACGBEG,ACGBEGIN,ACGEND,ACGRDA,ZTRTN,ZTDESC,ACGQUIT,ACGPM,ACGPP,ACGTC,ACG26X,ACG303,ACG304,ACG305,ACG306,ACG307,ACG4X,ACG5,ACGCMP,ACGDT,ACGDUZ,ACGPHONE
  1.  K ACGSP,ACGY
  1.  Q
  1. EN1 K ACGQUIT
  1.  D QT
  1.  I $D(ACGQUIT) K ACGQUIT Q
  1.  I $P(ACGPARA,U,3)=236 D CO Q:$D(ACGQUIT)  I 1
  1.  E  S (ACG4X,ACG4XX)=$P(ACGPARA,U,3)
  1. ZIS S ACGDUZ=$P(^VA(200,DUZ,0),U),ACGDUZ=$P($P(ACGDUZ,",",2)," ")_" "_$P(ACGDUZ,",")
  1.  S DIR(0)="F^3:30",DIR("A")="Person Submitting Report",DIR("B")=ACGDUZ,DIR("?")="Enter the name of the person submitting this Small Purchase report."
  1.  W !
  1.  D DIR^ACGSDIC
  1.  I Y=""!$D(ACGQUIT) Q
  1.  S ACGDUZ=Y
  1.  S DIR(0)="YO",DIR("A")="Print Source Document List",DIR("B")="NO",DIR("?")="Enter 'Y' to print a list of all source documents included in this 281 report."
  1.  W !
  1.  D DIR^ACGSDIC
  1.  I $D(ACGQUIT) Q
  1.  S ACGSDOC=Y
  1.  S DIR(0)="SO^1:ORIGINAL;2:REVISION",DIR("A")="Which one",DIR("B")="ORIGINAL"
  1.  W !
  1.  D DIR^ACGSDIC
  1.  I Y=""!$D(ACGQUIT) Q
  1.  S ACGORIGN=Y,ACGPHONE=""
  1.  S ZTRTN="REPORT^ACGS281",ZTDESC="SMALL PURCHASE 281 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 ACG4XX=102,121,161,235,239,241:1:249,284,285 K ACGQUIT D R1
  1.  I ACG4X=88 D DONE^ACGSZIS Q
  1. R1 I $D(ACGQUIT) D DONE^ACGSZIS Q
  1.  D BEGIN,HEAD
  1.  W:$D(IOF) @IOF
  1.  D DONE^ACGSZIS
  1.  I ACGSDOC=1 D
  1.  .I $D(IOST),$E(IOST,1,2)="C-" D WAIT^DICD
  1.  .S IOP=ACGIOP,DIC="^ACGS(",FLDS="[ACG 281 SOURCE DOCUMENTS]",BY="[ACG 281 SOURCE DOCUMENTS]",FR="P,"_ACGBEGIN_",,,",TO="PM,"_ACGEND_",,,",DIS(0)="I $P($G(^ACGS(D0,""DT"")),U,2)'[""PEND"""
  1.  .I ACG4XX>100 S DIS(0)="I $P($G(^ACGS(D0,""DT"")),U,4)=ACG4XX"
  1.  .D EN1^DIP
  1.  .I $D(IOST),$E(IOST,1,2)="C-" D HOLD^ACGSMENU
  1.  .W:$D(IOF) @IOF
  1.  .D DONE^ACGSZIS
  1.  Q
  1. BEGIN K ACGT
  1.  F ACG=0:1:9,"A","B","C" S ACGPM(ACG4XX,ACG)=0 F ACG1=0,"A1","A2","A3","A4" S ACGPM(ACG4XX,ACG,ACG1)=0
  1.  F ACG="A1","A2","A3","A4" S ACGPM(ACG4XX,ACG)=0
  1.  S ACGPM(ACG4XX)=0
  1.  F ACG="A","B","C" S ACGCMP(ACG4XX,ACG)=0 F ACG1=0,"A1","A2","A3","A4" S ACGCMP(ACG4XX,ACG,ACG1)=0
  1.  F ACG=1:1:5 S ACGPP(ACG4XX,ACG)=0
  1.  F ACG=1:1:6 S ACGTC(ACG4XX,ACG)=0
  1.  S ACGBEG=ACGBEGIN,ACG26X=0
  1.  F  S ACGBEG=$O(^ACGS("R",ACGBEG)) Q:'ACGBEG!(ACGBEG>ACGEND)  D B1^ACGS282
  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")_"00",ACGEND=2_ACGFY_$S(ACGQT=1:12,ACGQT=2:"03",ACGQT=3:"06",1:"09")_$S(ACGQT<3:31,1:30)
  1.  S ACGBEGIN=(ACGFY-1700)_$S(ACGQT=1!(ACGQT=5):10,ACGQT=2:"01",ACGQT=3:"04",1:"07")_"00",ACGEND=(ACGFY-1700)_$S(ACGQT=1:12,ACGQT=2:"03",ACGQT=3:"06",1:"09")_$S(ACGQT<3:31,1:30) ;y2k;mlp
  1.  ;S:ACGQT=5 ACGEND=((ACGFY-1700)+1)_"0930" ;y2k;mlp
  1.  S:ACGQT=5 ACGEND=DT ;y2k;mlp
  1.  ;S ACGEND=(ACGFY+1)_"0930" ;y2k;mlp
  1.  S:ACGQT=1!(ACGQT=5) ACGFY=ACGFY+1
  1.  Q
  1. CO 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,ACG4XX)=+Y
  1.  Q
  1.  S Y=DT X ^DD("DD") S ACGTODAY=Y
  1.  W !?15,"FEDERAL PROCUREMENT DATA SYSTEM (FPDS)",!?15,"SUMMARY CONTRACT ACTION REPORT ($100,000 OR LESS)"
  1.  W !,"A. REPORT PERIOD",?25,"B. REPORT TYPE",?55,"C. REPORTING AGENCY CODE"
  1.  W !,"FY: ",ACGFY,"  QT: ",ACGQT,?25,"|",$S(ACGORIGN=1:"XX",1:"  "),"| ORIGINAL |",$S(ACGORIGN=2:"XX",1:"  "),"| REVISION"
  1.  D L
  1.  W !,"D. REPORTING AGENCY NAME",?27,"E. CONTRACT OFFICE CODE",?52,"F. CONTRACT OFFICE NAME"
  1.  W !?3,"INDIAN HEALTH SERVICE",?30,ACG4XX,?55,$P(^ACGPO($P(ACGPARA,U),0),U)
  1.  D L
  1.  W !?15,"PART I - PRIME CONTRACT ACTIONS OF $100,000 OR LESS"
  1.  D L
  1.  W !,"NEW AWARDS AND MODIFICATIONS",?30,"|",?40,"NET DOLLAR AMOUNTS"
  1.  W !,"------------------------------|-------------------------------------------------"
  1.  W !?20,"| NUMBER  |  SMALL  |  LARGE  |DOMESTIC |         |"
  1.  W !,?20,"|   OF    |BUSINESS |BUSINESS |OUTSIDE/ |  OTHER  |  TOTAL"
  1.  W !,"PROCUREMENT METHOD",?20,"| ACTIONS |CONCERNS |CONCERNS |FOREIGN  | ENTITIES| DOLLARS"
  1.  W !?20,"|   (a)   |   (b)   |   (c)   |   (d)   |   (e)   |   (f)  "
  1.  D ^ACGS2811
  1.  Q
  1. L W !,"--------------------------------------------------------------------------------"
  1.  Q