ACGS281 ;IHS/OIRM/DSD/THL,AEF - UTILITY TO PRINT THE SMALL PURCHASE 281 REPORT; [ 03/27/2000 5:49 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;UTILITY TO PRINT THE SMALL PURCHASE 281 REPORT
;;modfied for y2k;mlp;01/31/2000
EN S:'$D(ACGPARA) ACGPARA=^ACGPARA(1,0)
D EN1
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
K ACGSP,ACGY
Q
EN1 K ACGQUIT
D QT
I $D(ACGQUIT) K ACGQUIT Q
I $P(ACGPARA,U,3)=236 D CO Q:$D(ACGQUIT) I 1
E S (ACG4X,ACG4XX)=$P(ACGPARA,U,3)
ZIS S ACGDUZ=$P(^VA(200,DUZ,0),U),ACGDUZ=$P($P(ACGDUZ,",",2)," ")_" "_$P(ACGDUZ,",")
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."
W !
D DIR^ACGSDIC
I Y=""!$D(ACGQUIT) Q
S ACGDUZ=Y
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."
W !
D DIR^ACGSDIC
I $D(ACGQUIT) Q
S ACGSDOC=Y
S DIR(0)="SO^1:ORIGINAL;2:REVISION",DIR("A")="Which one",DIR("B")="ORIGINAL"
W !
D DIR^ACGSDIC
I Y=""!$D(ACGQUIT) Q
S ACGORIGN=Y,ACGPHONE=""
S ZTRTN="REPORT^ACGS281",ZTDESC="SMALL PURCHASE 281 REPORT"
D ^ACGSZIS
Q:$D(ACGQUIT)
REPORT I '$D(ZTQUEUED) S (ACGIOP,IOP)=ION D ^%ZIS I POP S ACGQUIT="" Q
U IO
I ACG4X=88 F ACG4XX=102,121,161,235,239,241:1:249,284,285 K ACGQUIT D R1
I ACG4X=88 D DONE^ACGSZIS Q
R1 I $D(ACGQUIT) D DONE^ACGSZIS Q
D BEGIN,HEAD
W:$D(IOF) @IOF
D DONE^ACGSZIS
I ACGSDOC=1 D
.I $D(IOST),$E(IOST,1,2)="C-" D WAIT^DICD
.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"""
.I ACG4XX>100 S DIS(0)="I $P($G(^ACGS(D0,""DT"")),U,4)=ACG4XX"
.D EN1^DIP
.I $D(IOST),$E(IOST,1,2)="C-" D HOLD^ACGSMENU
.W:$D(IOF) @IOF
.D DONE^ACGSZIS
Q
BEGIN K ACGT
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
F ACG="A1","A2","A3","A4" S ACGPM(ACG4XX,ACG)=0
S ACGPM(ACG4XX)=0
F ACG="A","B","C" S ACGCMP(ACG4XX,ACG)=0 F ACG1=0,"A1","A2","A3","A4" S ACGCMP(ACG4XX,ACG,ACG1)=0
F ACG=1:1:5 S ACGPP(ACG4XX,ACG)=0
F ACG=1:1:6 S ACGTC(ACG4XX,ACG)=0
S ACGBEG=ACGBEGIN,ACG26X=0
F S ACGBEG=$O(^ACGS("R",ACGBEG)) Q:'ACGBEG!(ACGBEG>ACGEND) D B1^ACGS282
Q
QT ;EP;TO DETERMINE DATE RANGE FOR QUARTERS
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"
W !
D DIR^ACGSDIC
Q:$D(ACGQUIT)
S ACGQT=+Y
I ACGQT=5 S ACGQTX=5,ACGQT=1
D FY^ACGSEXP
I $D(ACGQTX) S ACGQT=5 K ACGQTX
Q:$D(ACGQUIT)
PERIOD S:ACGQT=1!(ACGQT=5) ACGFY=ACGFY-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)
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
;S:ACGQT=5 ACGEND=((ACGFY-1700)+1)_"0930" ;y2k;mlp
S:ACGQT=5 ACGEND=DT ;y2k;mlp
;S ACGEND=(ACGFY+1)_"0930" ;y2k;mlp
S:ACGQT=1!(ACGQT=5) ACGFY=ACGFY+1
Q
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"
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"
D DIR^ACGSDIC
Q:$D(ACGQUIT)
S (ACG4X,ACG4XX)=+Y
Q
HEAD ;EP;TO PRINT HEADER
S Y=DT X ^DD("DD") S ACGTODAY=Y
W !?15,"FEDERAL PROCUREMENT DATA SYSTEM (FPDS)",!?15,"SUMMARY CONTRACT ACTION REPORT ($100,000 OR LESS)"
W !,"A. REPORT PERIOD",?25,"B. REPORT TYPE",?55,"C. REPORTING AGENCY CODE"
W !,"FY: ",ACGFY," QT: ",ACGQT,?25,"|",$S(ACGORIGN=1:"XX",1:" "),"| ORIGINAL |",$S(ACGORIGN=2:"XX",1:" "),"| REVISION"
D L
W !,"D. REPORTING AGENCY NAME",?27,"E. CONTRACT OFFICE CODE",?52,"F. CONTRACT OFFICE NAME"
W !?3,"INDIAN HEALTH SERVICE",?30,ACG4XX,?55,$P(^ACGPO($P(ACGPARA,U),0),U)
D L
W !?15,"PART I - PRIME CONTRACT ACTIONS OF $100,000 OR LESS"
D L
W !,"NEW AWARDS AND MODIFICATIONS",?30,"|",?40,"NET DOLLAR AMOUNTS"
W !,"------------------------------|-------------------------------------------------"
W !?20,"| NUMBER | SMALL | LARGE |DOMESTIC | |"
W !,?20,"| OF |BUSINESS |BUSINESS |OUTSIDE/ | OTHER | TOTAL"
W !,"PROCUREMENT METHOD",?20,"| ACTIONS |CONCERNS |CONCERNS |FOREIGN | ENTITIES| DOLLARS"
W !?20,"| (a) | (b) | (c) | (d) | (e) | (f) "
D ^ACGS2811
Q
L W !,"--------------------------------------------------------------------------------"
Q
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
+2 ;;UTILITY TO PRINT THE SMALL PURCHASE 281 REPORT
+3 ;;modfied for y2k;mlp;01/31/2000
EN IF '$DATA(ACGPARA)
SET ACGPARA=^ACGPARA(1,0)
+1 DO EN1
EXIT KILL 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 KILL ACGSP,ACGY
+2 QUIT
EN1 KILL ACGQUIT
+1 DO QT
+2 IF $DATA(ACGQUIT)
KILL ACGQUIT
QUIT
+3 IF $PIECE(ACGPARA,U,3)=236
DO CO
IF $DATA(ACGQUIT)
QUIT
IF 1
+4 IF '$TEST
SET (ACG4X,ACG4XX)=$PIECE(ACGPARA,U,3)
ZIS SET ACGDUZ=$PIECE(^VA(200,DUZ,0),U)
SET ACGDUZ=$PIECE($PIECE(ACGDUZ,",",2)," ")_" "_$PIECE(ACGDUZ,",")
+1 SET DIR(0)="F^3:30"
SET DIR("A")="Person Submitting Report"
SET DIR("B")=ACGDUZ
SET DIR("?")="Enter the name of the person submitting this Small Purchase report."
+2 WRITE !
+3 DO DIR^ACGSDIC
+4 IF Y=""!$DATA(ACGQUIT)
QUIT
+5 SET ACGDUZ=Y
+6 SET DIR(0)="YO"
SET DIR("A")="Print Source Document List"
SET DIR("B")="NO"
SET DIR("?")="Enter 'Y' to print a list of all source documents included in this 281 report."
+7 WRITE !
+8 DO DIR^ACGSDIC
+9 IF $DATA(ACGQUIT)
QUIT
+10 SET ACGSDOC=Y
+11 SET DIR(0)="SO^1:ORIGINAL;2:REVISION"
SET DIR("A")="Which one"
SET DIR("B")="ORIGINAL"
+12 WRITE !
+13 DO DIR^ACGSDIC
+14 IF Y=""!$DATA(ACGQUIT)
QUIT
+15 SET ACGORIGN=Y
SET ACGPHONE=""
+16 SET ZTRTN="REPORT^ACGS281"
SET ZTDESC="SMALL PURCHASE 281 REPORT"
+17 DO ^ACGSZIS
+18 IF $DATA(ACGQUIT)
QUIT
REPORT IF '$DATA(ZTQUEUED)
SET (ACGIOP,IOP)=ION
DO ^%ZIS
IF POP
SET ACGQUIT=""
QUIT
+1 USE IO
+2 IF ACG4X=88
FOR ACG4XX=102,121,161,235,239,241:1:249,284,285
KILL ACGQUIT
DO R1
+3 IF ACG4X=88
DO DONE^ACGSZIS
QUIT
R1 IF $DATA(ACGQUIT)
DO DONE^ACGSZIS
QUIT
+1 DO BEGIN
DO HEAD
+2 IF $DATA(IOF)
WRITE @IOF
+3 DO DONE^ACGSZIS
+4 IF ACGSDOC=1
Begin DoDot:1
+5 IF $DATA(IOST)
IF $EXTRACT(IOST,1,2)="C-"
DO WAIT^DICD
+6 SET IOP=ACGIOP
SET DIC="^ACGS("
SET FLDS="[ACG 281 SOURCE DOCUMENTS]"
SET BY="[ACG 281 SOURCE DOCUMENTS]"
SET FR="P,"_ACGBEGIN_",,,"
SET TO="PM,"_ACGEND_",,,"
SET DIS(0)="I $P($G(^ACGS(D0,""DT"")),U,2)'[""PEND"""
+7 IF ACG4XX>100
SET DIS(0)="I $P($G(^ACGS(D0,""DT"")),U,4)=ACG4XX"
+8 DO EN1^DIP
+9 IF $DATA(IOST)
IF $EXTRACT(IOST,1,2)="C-"
DO HOLD^ACGSMENU
+10 IF $DATA(IOF)
WRITE @IOF
+11 DO DONE^ACGSZIS
End DoDot:1
+12 QUIT
BEGIN KILL ACGT
+1 FOR ACG=0:1:9,"A","B","C"
SET ACGPM(ACG4XX,ACG)=0
FOR ACG1=0,"A1","A2","A3","A4"
SET ACGPM(ACG4XX,ACG,ACG1)=0
+2 FOR ACG="A1","A2","A3","A4"
SET ACGPM(ACG4XX,ACG)=0
+3 SET ACGPM(ACG4XX)=0
+4 FOR ACG="A","B","C"
SET ACGCMP(ACG4XX,ACG)=0
FOR ACG1=0,"A1","A2","A3","A4"
SET ACGCMP(ACG4XX,ACG,ACG1)=0
+5 FOR ACG=1:1:5
SET ACGPP(ACG4XX,ACG)=0
+6 FOR ACG=1:1:6
SET ACGTC(ACG4XX,ACG)=0
+7 SET ACGBEG=ACGBEGIN
SET ACG26X=0
+8 FOR
SET ACGBEG=$ORDER(^ACGS("R",ACGBEG))
IF 'ACGBEG!(ACGBEG>ACGEND)
QUIT
DO B1^ACGS282
+9 QUIT
QT ;EP;TO DETERMINE DATE RANGE FOR QUARTERS
+1 SET DIR(0)="SO^1:FIRST;2:SECOND;3:THIRD;4:FOURTH;5:YEAR-TO-DATE"
SET DIR("A")="Quarter...."
SET DIR("?")="Enter the quarter for the report"
+2 WRITE !
+3 DO DIR^ACGSDIC
+4 IF $DATA(ACGQUIT)
QUIT
+5 SET ACGQT=+Y
+6 IF ACGQT=5
SET ACGQTX=5
SET ACGQT=1
+7 DO FY^ACGSEXP
+8 IF $DATA(ACGQTX)
SET ACGQT=5
KILL ACGQTX
+9 IF $DATA(ACGQUIT)
QUIT
PERIOD IF ACGQT=1!(ACGQT=5)
SET 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)
+2 ;y2k;mlp
SET ACGBEGIN=(ACGFY-1700)_$SELECT(ACGQT=1!(ACGQT=5):10,ACGQT=2:"01",ACGQT=3:"04",1:"07")_"00"
SET ACGEND=(ACGFY-1700)_$SELECT(ACGQT=1:12,ACGQT=2:"03",ACGQT=3:"06",1:"09")_$SELECT(ACGQT<3:31,1:30)
+3 ;S:ACGQT=5 ACGEND=((ACGFY-1700)+1)_"0930" ;y2k;mlp
+4 ;y2k;mlp
IF ACGQT=5
SET ACGEND=DT
+5 ;S ACGEND=(ACGFY+1)_"0930" ;y2k;mlp
+6 IF ACGQT=1!(ACGQT=5)
SET ACGFY=ACGFY+1
+7 QUIT
CO SET 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 SET DIR(0)=DIR(0)_";284:Perry Point;285:Nashville;88:Each Office;99:Summary Report"
SET DIR("A")="Contracting Office"
SET DIR("?")="Enter the number of the Contracting office"
+2 DO DIR^ACGSDIC
+3 IF $DATA(ACGQUIT)
QUIT
+4 SET (ACG4X,ACG4XX)=+Y
+5 QUIT
HEAD ;EP;TO PRINT HEADER
+1 SET Y=DT
XECUTE ^DD("DD")
SET ACGTODAY=Y
+2 WRITE !?15,"FEDERAL PROCUREMENT DATA SYSTEM (FPDS)",!?15,"SUMMARY CONTRACT ACTION REPORT ($100,000 OR LESS)"
+3 WRITE !,"A. REPORT PERIOD",?25,"B. REPORT TYPE",?55,"C. REPORTING AGENCY CODE"
+4 WRITE !,"FY: ",ACGFY," QT: ",ACGQT,?25,"|",$SELECT(ACGORIGN=1:"XX",1:" "),"| ORIGINAL |",$SELECT(ACGORIGN=2:"XX",1:" "),"| REVISION"
+5 DO L
+6 WRITE !,"D. REPORTING AGENCY NAME",?27,"E. CONTRACT OFFICE CODE",?52,"F. CONTRACT OFFICE NAME"
+7 WRITE !?3,"INDIAN HEALTH SERVICE",?30,ACG4XX,?55,$PIECE(^ACGPO($PIECE(ACGPARA,U),0),U)
+8 DO L
+9 WRITE !?15,"PART I - PRIME CONTRACT ACTIONS OF $100,000 OR LESS"
+10 DO L
+11 WRITE !,"NEW AWARDS AND MODIFICATIONS",?30,"|",?40,"NET DOLLAR AMOUNTS"
+12 WRITE !,"------------------------------|-------------------------------------------------"
+13 WRITE !?20,"| NUMBER | SMALL | LARGE |DOMESTIC | |"
+14 WRITE !,?20,"| OF |BUSINESS |BUSINESS |OUTSIDE/ | OTHER | TOTAL"
+15 WRITE !,"PROCUREMENT METHOD",?20,"| ACTIONS |CONCERNS |CONCERNS |FOREIGN | ENTITIES| DOLLARS"
+16 WRITE !?20,"| (a) | (b) | (c) | (d) | (e) | (f) "
+17 DO ^ACGS2811
+18 QUIT
L WRITE !,"--------------------------------------------------------------------------------"
+1 QUIT
