- ACGS282 ;IHS/OIRM/DSD/THL,AEF - UTILITY TO PRINT THE SMALL PURCHASE 281 REPORT - CONT; [ 03/27/2000 2:22 PM ]
- ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
- ;;UTILITY TO PRINT THE SMALL PURCHASE 281 REPORT
- ;;modified for y2k;mlp;01/31/2000
- B1 ;EP
- S ACGRDA=0
- F S ACGRDA=$O(^ACGS("R",ACGBEG,ACGRDA)) Q:'ACGRDA I "^15^17^"[(U_+^ACGS(ACGRDA,"DT")_U),$D(^("SP")) S ACGDT=^("DT"),ACG26=$P($P(^("DT1"),U,5),"."),ACGSP=^("SP") D
- .Q:$P(ACGDT,U,2)["PENDING"
- .I ACG4X'=99 Q:$P(ACGDT,U,4)'=ACG4X
- .I $P(ACGSP,U,7)="" S ACG12=$P(ACGDT,U,12) I ACG12]"" S:ACG12="D" ACG12="C" S DA=ACGRDA,DIE="^ACGS(",DR="307////"_ACG12 D DIE^ACGSDIC W "."
- .F ACG=3:1:7 S @("ACG30"_ACG)=$P(ACGSP,U,ACG)
- .F ACG=3:1:7 I @("ACG30"_ACG)="" S ACGQUIT="" Q
- .I $D(ACGQUIT) K ACGQUIT Q
- .;SET PROCUREMENT METHOD/TYPE OF BUSINESS BUCKETS
- .S $P(ACGPM(ACG4XX,ACG306,ACG304),U)=$P(ACGPM(ACG4XX,ACG306,ACG304),U)+ACG26,$P(ACGPM(ACG4XX,ACG306),U)=$P(ACGPM(ACG4XX,ACG306),U)+ACG26,$P(ACGPM(ACG4XX,ACG304),U)=$P(ACGPM(ACG4XX,ACG304),U)+ACG26,ACGPM(ACG4XX)=ACGPM(ACG4XX)+ACG26
- .S $P(ACGPM(ACG4XX,ACG306),U,2)=$P(ACGPM(ACG4XX,ACG306),U,2)+1,$P(ACGPM(ACG4XX,1),U,3)=$P(ACGPM(ACG4XX,1),U,3)+1,$P(ACGPM(ACG4XX,1),U,4)=$P(ACGPM(ACG4XX,1),U,4)+ACG26
- .;SET PREFERENCE PROGRAM BUCKETS
- .S $P(ACGPP(ACG4XX,ACG303),U)=$P(ACGPP(ACG4XX,ACG303),U)+ACG26,$P(ACGPP(ACG4XX,ACG303),U,2)=$P(ACGPP(ACG4XX,ACG303),U,2)+1
- .;SET TYPE OF CONTRACTOR BUCKETS
- .S $P(ACGTC(ACG4XX,ACG305),U)=$P(ACGTC(ACG4XX,ACG305),U)+ACG26,$P(ACGTC(ACG4XX,ACG305),U,2)=$P(ACGTC(ACG4XX,ACG305),U,2)+1
- .;SET EXTEND COMPETED BUCKETS
- .S $P(ACGPM(ACG4XX,ACG307,ACG304),U)=$P(ACGPM(ACG4XX,ACG307,ACG304),U)+ACG26,$P(ACGPM(ACG4XX,ACG307),U)=$P(ACGPM(ACG4XX,ACG307),U)+ACG26,$P(ACGPM(ACG4XX,ACG307),U,2)=$P(ACGPM(ACG4XX,ACG307),U,2)+1
- 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_$S(ACGQT=1!(ACGQT=5):10,ACGQT=2:"01",ACGQT=3:"04",1:"07")_"00",ACGEND=ACGFY_$S(ACGQT=1:12,ACGQT=2:"03",ACGQT=3:"06",1:"09")_$S(ACGQT<3:31,1:30) ;y2k;mlp
- ;S:ACGQT=5 ACGEND=2_(ACGFY+1)_"0930"
- S:ACGQT=5 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 (THOUSANDS)"
- 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
- ACGS282 ;IHS/OIRM/DSD/THL,AEF - UTILITY TO PRINT THE SMALL PURCHASE 281 REPORT - CONT; [ 03/27/2000 2:22 PM ]
- +1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
- +2 ;;UTILITY TO PRINT THE SMALL PURCHASE 281 REPORT
- +3 ;;modified for y2k;mlp;01/31/2000
- B1 ;EP
- +1 SET ACGRDA=0
- +2 FOR
- SET ACGRDA=$ORDER(^ACGS("R",ACGBEG,ACGRDA))
- IF 'ACGRDA
- QUIT
- IF "^15^17^"[(U_+^ACGS(ACGRDA,"DT")_U)
- IF $DATA(^("SP"))
- SET ACGDT=^("DT")
- SET ACG26=$PIECE($PIECE(^("DT1"),U,5),".")
- SET ACGSP=^("SP")
- Begin DoDot:1
- +3 IF $PIECE(ACGDT,U,2)["PENDING"
- QUIT
- +4 IF ACG4X'=99
- IF $PIECE(ACGDT,U,4)'=ACG4X
- QUIT
- +5 IF $PIECE(ACGSP,U,7)=""
- SET ACG12=$PIECE(ACGDT,U,12)
- IF ACG12]""
- IF ACG12="D"
- SET ACG12="C"
- SET DA=ACGRDA
- SET DIE="^ACGS("
- SET DR="307////"_ACG12
- DO DIE^ACGSDIC
- WRITE "."
- +6 FOR ACG=3:1:7
- SET @("ACG30"_ACG)=$PIECE(ACGSP,U,ACG)
- +7 FOR ACG=3:1:7
- IF @("ACG30"_ACG)=""
- SET ACGQUIT=""
- QUIT
- +8 IF $DATA(ACGQUIT)
- KILL ACGQUIT
- QUIT
- +9 ;SET PROCUREMENT METHOD/TYPE OF BUSINESS BUCKETS
- +10 SET $PIECE(ACGPM(ACG4XX,ACG306,ACG304),U)=$PIECE(ACGPM(ACG4XX,ACG306,ACG304),U)+ACG26
- SET $PIECE(ACGPM(ACG4XX,ACG306),U)=$PIECE(ACGPM(ACG4XX,ACG306),U)+ACG26
- SET $PIECE(ACGPM(ACG4XX,ACG304),U)=$PIECE(ACGPM(ACG4XX,ACG304),U)+ACG26
- SET ACGPM(ACG4XX)=ACGPM(ACG4XX)+ACG26
- +11 SET $PIECE(ACGPM(ACG4XX,ACG306),U,2)=$PIECE(ACGPM(ACG4XX,ACG306),U,2)+1
- SET $PIECE(ACGPM(ACG4XX,1),U,3)=$PIECE(ACGPM(ACG4XX,1),U,3)+1
- SET $PIECE(ACGPM(ACG4XX,1),U,4)=$PIECE(ACGPM(ACG4XX,1),U,4)+ACG26
- +12 ;SET PREFERENCE PROGRAM BUCKETS
- +13 SET $PIECE(ACGPP(ACG4XX,ACG303),U)=$PIECE(ACGPP(ACG4XX,ACG303),U)+ACG26
- SET $PIECE(ACGPP(ACG4XX,ACG303),U,2)=$PIECE(ACGPP(ACG4XX,ACG303),U,2)+1
- +14 ;SET TYPE OF CONTRACTOR BUCKETS
- +15 SET $PIECE(ACGTC(ACG4XX,ACG305),U)=$PIECE(ACGTC(ACG4XX,ACG305),U)+ACG26
- SET $PIECE(ACGTC(ACG4XX,ACG305),U,2)=$PIECE(ACGTC(ACG4XX,ACG305),U,2)+1
- +16 ;SET EXTEND COMPETED BUCKETS
- +17 SET $PIECE(ACGPM(ACG4XX,ACG307,ACG304),U)=$PIECE(ACGPM(ACG4XX,ACG307,ACG304),U)+ACG26
- SET $PIECE(ACGPM(ACG4XX,ACG307),U)=$PIECE(ACGPM(ACG4XX,ACG307),U)+ACG26
- SET $PIECE(ACGPM(ACG4XX,ACG307),U,2)=$PIECE(ACGPM(ACG4XX,ACG307),U,2)+1
- End DoDot:1
- +18 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_$SELECT(ACGQT=1!(ACGQT=5):10,ACGQT=2:"01",ACGQT=3:"04",1:"07")_"00"
- SET ACGEND=ACGFY_$SELECT(ACGQT=1:12,ACGQT=2:"03",ACGQT=3:"06",1:"09")_$SELECT(ACGQT<3:31,1:30)
- +3 ;S:ACGQT=5 ACGEND=2_(ACGFY+1)_"0930"
- +4 ;y2k;mlp
- IF ACGQT=5
- SET ACGEND=(ACGFY+1)_"0930"
- +5 IF ACGQT=1!(ACGQT=5)
- SET ACGFY=ACGFY+1
- +6 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 (THOUSANDS)"
- +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
