ACGSRT ;IHS/OIRM/DSD/THL,AEF - SORT CONTROLLER FOR REPORTS; [ 03/27/2000 2:22 PM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;SORT CONTROLLER FOR REPORTS
EN K ACGQUIT,ACGXZ
D ^ACGSRT2
Q:$D(ACGQUIT)
EN1 D HEAD,CHOICE,EXIT Q
HEAD D HEAD^ACGSMENU S ACGX="REPORT SORTING UTILITY"
W !!?80-$L(ACGX)\2,ACGX,!!?10,"The ",@ACGON,ACGRPT,@ACGOF," report can be sorted by one or more",!?10,"of the following attributes. '<==' indicates a mandatory selection.",! K ACGX,ACGFORC
Q
SORT W !!?10,"Sorting by: " S ACGXZZ=$O(ACGXZ(0)) Q:'ACGXZZ W ACGXZ(ACGXZZ) F S ACGXZZ=$O(ACGXZ(ACGXZZ)) Q:'ACGXZZ W !?16,"then: ",ACGXZ(ACGXZZ)
Q
CHOICE D M2 I $D(ACGXZ) D SORT
S DIR(0)="NOA^1:"_ACGJ,DIR("A")=" Your choice (1"_$S((ACGJ)>1:"-"_(ACGJ),1:"")_"): ",DIR("?")="Type "_$S((ACGJ)>1:"a number from 1",1:"number 1: ")_$S((ACGJ)>1:"-"_(ACGJ)_":",1:"")
W !
D DIR^ACGSDIC
Q:$D(ACGQUIT)!(Y<1)
S ACGZZ=+Y
I '$D(ACGUB(ACGZZ)) W !!?10,ACGZZ," has already been processed.",!! G CHOICE
G:'ACGZZ CHOICE
OK S:'$D(ACGXZ) ACGXZ=0 S ACGYZ=ACGU(ACGZZ),(X,ACGSNO)=+ACGYZ,ACGSNA=$P(ACGYZ,U,2),ACGCSTG=ACGCSTG_ACGZZ_U S ACGXZ(ACGXZ+1)=ACGSNA,ACGXZ=ACGXZ+1
;ACGXZ_$S(ACGXZ'="":", then ",1:"")_
K ACGYZ W " ",ACGSNA
OK1 I BY'="" S BY=BY_","
S ACGNAV=^ACGSRT(X,0)
K ACGJ
S ACGBY=^ACGSRT(X,3)
D @("S"_$P(ACGNAV,U,2)_"^ACGSRT1")
K ACGNAV
I $D(ACGQUIT) Q
I $D(ACGFORC) K ACGFORC D PRINT Q
I ACGYI<2 S BY=BY_ACGBY D PRINT Q
G:'$D(ACGBY) EN1
S ACGUB(ACGZZ)=1
I ACGBY="" K ACGXZ(ACGXZ) G EN1
S BY=BY_ACGBY
I BY[26 D PRINT Q
W !!,"Within ",ACGSNA,", want to sort by another attribute"
S %=2 D YN^DICN
I %Y=U S ACGQUIT="" Q
I "Nn"[$E(%Y) D CHECK G:$D(ACGFORC) OK D PRINT Q
G EN1
EXIT D EXIT^ACGSRT1 Q
M2 K ACGU S ACGZ=0
S ACGJJ=(ACGYI\2)+(ACGYI#2)
F ACGJ=1:1:ACGJJ D
.I $D(ACGUB(ACGJ)) S (ACGU(ACGJ),ACGSRT)=ACGUB(ACGJ),X=$P(ACGSRT,U,2),Y=$P(ACGSRT,U),ACGYZ=$P(ACGSRT,U,3) W !?8,$J(ACGJ,3),") " W:ACGUB(ACGJ)'=1 X I ACGYZ W " <==" S ACGMAND=ACGJ,ACGMANN=X,ACGMAN=Y_U_X
.I $D(ACGUB(ACGJ+ACGJJ)) S (ACGU(ACGJ+ACGJJ),ACGSRT)=ACGUB(ACGJ+ACGJJ),X=$P(ACGSRT,U,2),Y=$P(ACGSRT,U),ACGYZ=$P(ACGSRT,U,3) W ?45 W $J(ACGJ+ACGJJ,3),") " W:ACGUB(ACGJ+ACGJJ)'=1 X I ACGYZ W " <==" S ACGMAND=ACGJ+ACGJJ,ACGMANN=X,ACGMAN=Y_U_X
S ACGJ=ACGYI
K ACGSRT,ACGZ,ACGYZ
Q
PRINT S DIC=ACGDIC
K ACGJ
I BY[26 D Q:$D(ACGQUIT) G FY
.S DIR(0)="SO^1:Number and Dollar Amount Only;2:List of All Actions",DIR("A")="Which Report",DIR("B")=1,DIR("?",1)="Enter '1' to get the number of awards and total dollar amount only,"
.S DIR("?")="Enter '2' to get list of all contract actions within the dollar range specified."
.W !
.D DIR^ACGSDIC
.Q:$D(ACGQUIT)
.S FLDS="[ACG DOLLAR AMOUNT"_$S(Y=1:" COUNT",1:"")_"]"
S DIR(0)="SO^1:CONTRACT SUMMARY;2:BRIEF CONTRACT SUMMARY;3:COMPLETE DATA SET;4:SMALL PURCHASE SUMMARY;5:PURCHASE ORDER LISTING",DIR("B")="CONTRACT SUMMARY"
W !
D ^DIR K DIR
Q:$D(ACGQUIT)
S:Y=2 FLDS="[ACG CONTRACT DATA]",ACGAH=""
S:Y=3 FLDS="[ACG PHSCIS SUMMARY]",ACGAH=""
S:Y=4 FLDS="[ACG SP SUMMARY]",ACGAH=""
S:Y=5 FLDS="[ACG 281 SOURCE DOCUMENTS]",ACGAH=""
FY S DIR(0)="YO",DIR("A")="Print Report for one Fiscal Year only",DIR("B")="NO",DIR("?")="Enter 'Y' if you wish to print this report for only one Fiscal Year."
W !
D DIR^ACGSDIC
Q:$D(ACGQUIT)
I Y=1 D FY^ACGSEXP D
.I ACGFY?2N S DIS(0)="I $D(^ACGS(D0,""DT"")) Q:+^(""DT"")=14 I $E($P(^(""DT""),U,2),4,5)="_ACGFY
.E S ACGFY=""
I FLDS="[ACG CONTRACT DATA]" W !!,"Select Fiscal Year for calculation of Fiscal Year TOTAL" D FY^ACGSEXP
Q:$D(ACGQUIT)
PRT1 S ZTDESC="CIS ADHOC REPORT",ZTRTN="DIP^ACGSRT"
D ^ACGSZIS
I $D(ACGQUIT) K ACGQUIT,ACGAH Q
S DIOEND=$S(BY'[26:"D TAIL^ACGSPSUM ",1:"")_"W:IOST[""C-"" !!,""End of report."" D:IOST[""C-"" HOLD^ACGSMENU W:$D(IOF) @IOF"
W ! D WAIT^DICD W !
DIP I BY'[26 S:+BY'=1&(BY'["#1,")&(BY'[",1,") BY=BY_",@'.01",FR=FR_"0,",TO=TO_"0,"
I +BY'=1&(BY'["#1,")&(BY'[",1,")&($E(FR)'="P")&(FR'[",P,"),+BY'=2&(BY'[",2,")&(BY'[",@2,") S BY=BY_",@2"
I +BY'=1&(BY'["#1,")&(BY'[",1,")&($E(FR)'="P")&(FR'[",P,") S DIS(0)=$S($G(DIS(0))]"":DIS(0)_" ",1:"")_"I +$G(^ACGS(D0,""DT""))'=15,+$G(^(""DT""))'=17"
DIS S IOP=ACGION
S (ACGTD,ACGTI,ACGTOTD,ACGTOTI,ACGTOTDT,ACGTOTIT,ACGTOTDI)=0,DC=""
I BY[26 D SUB26
S:ACG4'=236 DIS(0)="I $P($G(^ACGS(D0,""DT"")),U,4)=ACG4 "_$S($D(DIS(0)):DIS(0),1:"")
D EN1^DIP,^%ZISC
K IOP,ACGAH,ACGDF,ACGDT
Q
CHECK I ACGCSTG[(U_ACGMAND_U) Q
S ACGZZZ=ACGMAND,ACGFORC="",ACGN=ACGN+1
W !!,*7,"You must also sort by"
Q
DOLLAR ;EP;
K ACGQUIT
S DIR(0)="YO",DIR("A")="Print Report for a specified Dollar Threshold",DIR("B")="NO"
W !
D DIR^ACGSDIC
Q:Y'=1!$D(ACGQUIT)
S DIR(0)="NO^0:99999999",DIR("A")="Dollar Threshold",DIR("?")="Enter the dollar threshold you wish to use for this report.",DIR("?",1)="Enter the dollar amount without commas or cents, e.g., '100000'."
W !
D DIR^ACGSDIC
Q:+Y<1!$D(ACGQUIT)
S ACGDOLLR=+Y,DIS(0)=$S($D(DIS(0)):DIS(0)_" ",1:"")_"I $D(^ACGS(D0,""IHS"")),$P(^(""IHS""),U,7)>(ACGDOLLR-1)"
Q
SUB26 ;
N ACGI,X
F ACGI=1:1:$L(BY,",") S X=$P(BY,",",ACGI) Q:X[26!(X[23)!(X[24)!(X[25) S:X'["+" X="+"_X,$P(BY,",",ACGI)=X
Q
ACGSRT ;IHS/OIRM/DSD/THL,AEF - SORT CONTROLLER FOR REPORTS; [ 03/27/2000 2:22 PM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;SORT CONTROLLER FOR REPORTS
EN KILL ACGQUIT,ACGXZ
+1 DO ^ACGSRT2
+2 IF $DATA(ACGQUIT)
QUIT
EN1 DO HEAD
DO CHOICE
DO EXIT
QUIT
HEAD DO HEAD^ACGSMENU
SET ACGX="REPORT SORTING UTILITY"
+1 WRITE !!?80-$LENGTH(ACGX)\2,ACGX,!!?10,"The ",@ACGON,ACGRPT,@ACGOF," report can be sorted by one or more",!?10,"of the following attributes. '<==' indicates a mandatory selection.",!
KILL ACGX,ACGFORC
+2 QUIT
SORT WRITE !!?10,"Sorting by: "
SET ACGXZZ=$ORDER(ACGXZ(0))
IF 'ACGXZZ
QUIT
WRITE ACGXZ(ACGXZZ)
FOR
SET ACGXZZ=$ORDER(ACGXZ(ACGXZZ))
IF 'ACGXZZ
QUIT
WRITE !?16,"then: ",ACGXZ(ACGXZZ)
+1 QUIT
CHOICE DO M2
IF $DATA(ACGXZ)
DO SORT
+1 SET DIR(0)="NOA^1:"_ACGJ
SET DIR("A")=" Your choice (1"_$SELECT((ACGJ)>1:"-"_(ACGJ),1:"")_"): "
SET DIR("?")="Type "_$SELECT((ACGJ)>1:"a number from 1",1:"number 1: ")_$SELECT((ACGJ)>1:"-"_(ACGJ)_":",1:"")
+2 WRITE !
+3 DO DIR^ACGSDIC
+4 IF $DATA(ACGQUIT)!(Y<1)
QUIT
+5 SET ACGZZ=+Y
+6 IF '$DATA(ACGUB(ACGZZ))
WRITE !!?10,ACGZZ," has already been processed.",!!
GOTO CHOICE
+7 IF 'ACGZZ
GOTO CHOICE
OK IF '$DATA(ACGXZ)
SET ACGXZ=0
SET ACGYZ=ACGU(ACGZZ)
SET (X,ACGSNO)=+ACGYZ
SET ACGSNA=$PIECE(ACGYZ,U,2)
SET ACGCSTG=ACGCSTG_ACGZZ_U
SET ACGXZ(ACGXZ+1)=ACGSNA
SET ACGXZ=ACGXZ+1
+1 ;ACGXZ_$S(ACGXZ'="":", then ",1:"")_
+2 KILL ACGYZ
WRITE " ",ACGSNA
OK1 IF BY'=""
SET BY=BY_","
+1 SET ACGNAV=^ACGSRT(X,0)
+2 KILL ACGJ
+3 SET ACGBY=^ACGSRT(X,3)
+4 DO @("S"_$PIECE(ACGNAV,U,2)_"^ACGSRT1")
+5 KILL ACGNAV
+6 IF $DATA(ACGQUIT)
QUIT
+7 IF $DATA(ACGFORC)
KILL ACGFORC
DO PRINT
QUIT
+8 IF ACGYI<2
SET BY=BY_ACGBY
DO PRINT
QUIT
+9 IF '$DATA(ACGBY)
GOTO EN1
+10 SET ACGUB(ACGZZ)=1
+11 IF ACGBY=""
KILL ACGXZ(ACGXZ)
GOTO EN1
+12 SET BY=BY_ACGBY
+13 IF BY[26
DO PRINT
QUIT
+14 WRITE !!,"Within ",ACGSNA,", want to sort by another attribute"
+15 SET %=2
DO YN^DICN
+16 IF %Y=U
SET ACGQUIT=""
QUIT
+17 IF "Nn"[$EXTRACT(%Y)
DO CHECK
IF $DATA(ACGFORC)
GOTO OK
DO PRINT
QUIT
+18 GOTO EN1
EXIT DO EXIT^ACGSRT1
QUIT
M2 KILL ACGU
SET ACGZ=0
+1 SET ACGJJ=(ACGYI\2)+(ACGYI#2)
+2 FOR ACGJ=1:1:ACGJJ
Begin DoDot:1
+3 IF $DATA(ACGUB(ACGJ))
SET (ACGU(ACGJ),ACGSRT)=ACGUB(ACGJ)
SET X=$PIECE(ACGSRT,U,2)
SET Y=$PIECE(ACGSRT,U)
SET ACGYZ=$PIECE(ACGSRT,U,3)
WRITE !?8,$JUSTIFY(ACGJ,3),") "
IF ACGUB(ACGJ)'=1
WRITE X
IF ACGYZ
WRITE " <=="
SET ACGMAND=ACGJ
SET ACGMANN=X
SET ACGMAN=Y_U_X
+4 IF $DATA(ACGUB(ACGJ+ACGJJ))
SET (ACGU(ACGJ+ACGJJ),ACGSRT)=ACGUB(ACGJ+ACGJJ)
SET X=$PIECE(ACGSRT,U,2)
SET Y=$PIECE(ACGSRT,U)
SET ACGYZ=$PIECE(ACGSRT,U,3)
WRITE ?45
WRITE $JUSTIFY(ACGJ+ACGJJ,3),") "
IF ACGUB(ACGJ+ACGJJ)'=1
WRITE X
IF ACGYZ
WRITE " <=="
SET ACGMAND=ACGJ+ACGJJ
SET ACGMANN=X
SET ACGMAN=Y_U_X
End DoDot:1
+5 SET ACGJ=ACGYI
+6 KILL ACGSRT,ACGZ,ACGYZ
+7 QUIT
PRINT SET DIC=ACGDIC
+1 KILL ACGJ
+2 IF BY[26
Begin DoDot:1
+3 SET DIR(0)="SO^1:Number and Dollar Amount Only;2:List of All Actions"
SET DIR("A")="Which Report"
SET DIR("B")=1
SET DIR("?",1)="Enter '1' to get the number of awards and total dollar amount only,"
+4 SET DIR("?")="Enter '2' to get list of all contract actions within the dollar range specified."
+5 WRITE !
+6 DO DIR^ACGSDIC
+7 IF $DATA(ACGQUIT)
QUIT
+8 SET FLDS="[ACG DOLLAR AMOUNT"_$SELECT(Y=1:" COUNT",1:"")_"]"
End DoDot:1
IF $DATA(ACGQUIT)
QUIT
GOTO FY
+9 SET DIR(0)="SO^1:CONTRACT SUMMARY;2:BRIEF CONTRACT SUMMARY;3:COMPLETE DATA SET;4:SMALL PURCHASE SUMMARY;5:PURCHASE ORDER LISTING"
SET DIR("B")="CONTRACT SUMMARY"
+10 WRITE !
+11 DO ^DIR
KILL DIR
+12 IF $DATA(ACGQUIT)
QUIT
+13 IF Y=2
SET FLDS="[ACG CONTRACT DATA]"
SET ACGAH=""
+14 IF Y=3
SET FLDS="[ACG PHSCIS SUMMARY]"
SET ACGAH=""
+15 IF Y=4
SET FLDS="[ACG SP SUMMARY]"
SET ACGAH=""
+16 IF Y=5
SET FLDS="[ACG 281 SOURCE DOCUMENTS]"
SET ACGAH=""
FY SET DIR(0)="YO"
SET DIR("A")="Print Report for one Fiscal Year only"
SET DIR("B")="NO"
SET DIR("?")="Enter 'Y' if you wish to print this report for only one Fiscal Year."
+1 WRITE !
+2 DO DIR^ACGSDIC
+3 IF $DATA(ACGQUIT)
QUIT
+4 IF Y=1
DO FY^ACGSEXP
Begin DoDot:1
+5 IF ACGFY?2N
SET DIS(0)="I $D(^ACGS(D0,""DT"")) Q:+^(""DT"")=14 I $E($P(^(""DT""),U,2),4,5)="_ACGFY
+6 IF '$TEST
SET ACGFY=""
End DoDot:1
+7 IF FLDS="[ACG CONTRACT DATA]"
WRITE !!,"Select Fiscal Year for calculation of Fiscal Year TOTAL"
DO FY^ACGSEXP
+8 IF $DATA(ACGQUIT)
QUIT
PRT1 SET ZTDESC="CIS ADHOC REPORT"
SET ZTRTN="DIP^ACGSRT"
+1 DO ^ACGSZIS
+2 IF $DATA(ACGQUIT)
KILL ACGQUIT,ACGAH
QUIT
+3 SET DIOEND=$SELECT(BY'[26:"D TAIL^ACGSPSUM ",1:"")_"W:IOST[""C-"" !!,""End of report."" D:IOST[""C-"" HOLD^ACGSMENU W:$D(IOF) @IOF"
+4 WRITE !
DO WAIT^DICD
WRITE !
DIP IF BY'[26
IF +BY'=1&(BY'["#1,")&(BY'[",1,")
SET BY=BY_",@'.01"
SET FR=FR_"0,"
SET TO=TO_"0,"
+1 IF +BY'=1&(BY'["#1,")&(BY'[",1,")&($EXTRACT(FR)'="P")&(FR'[",P,")
IF +BY'=2&(BY'[",2,")&(BY'[",@2,")
SET BY=BY_",@2"
+2 IF +BY'=1&(BY'["#1,")&(BY'[",1,")&($EXTRACT(FR)'="P")&(FR'[",P,")
SET DIS(0)=$SELECT($GET(DIS(0))]"":DIS(0)_" ",1:"")_"I +$G(^ACGS(D0,""DT""))'=15,+$G(^(""DT""))'=17"
DIS SET IOP=ACGION
+1 SET (ACGTD,ACGTI,ACGTOTD,ACGTOTI,ACGTOTDT,ACGTOTIT,ACGTOTDI)=0
SET DC=""
+2 IF BY[26
DO SUB26
+3 IF ACG4'=236
SET DIS(0)="I $P($G(^ACGS(D0,""DT"")),U,4)=ACG4 "_$SELECT($DATA(DIS(0)):DIS(0),1:"")
+4 DO EN1^DIP
DO ^%ZISC
+5 KILL IOP,ACGAH,ACGDF,ACGDT
+6 QUIT
CHECK IF ACGCSTG[(U_ACGMAND_U)
QUIT
+1 SET ACGZZZ=ACGMAND
SET ACGFORC=""
SET ACGN=ACGN+1
+2 WRITE !!,*7,"You must also sort by"
+3 QUIT
DOLLAR ;EP;
+1 KILL ACGQUIT
+2 SET DIR(0)="YO"
SET DIR("A")="Print Report for a specified Dollar Threshold"
SET DIR("B")="NO"
+3 WRITE !
+4 DO DIR^ACGSDIC
+5 IF Y'=1!$DATA(ACGQUIT)
QUIT
+6 SET DIR(0)="NO^0:99999999"
SET DIR("A")="Dollar Threshold"
SET DIR("?")="Enter the dollar threshold you wish to use for this report."
SET DIR("?",1)="Enter the dollar amount without commas or cents, e.g., '100000'."
+7 WRITE !
+8 DO DIR^ACGSDIC
+9 IF +Y<1!$DATA(ACGQUIT)
QUIT
+10 SET ACGDOLLR=+Y
SET DIS(0)=$SELECT($DATA(DIS(0)):DIS(0)_" ",1:"")_"I $D(^ACGS(D0,""IHS"")),$P(^(""IHS""),U,7)>(ACGDOLLR-1)"
+11 QUIT
SUB26 ;
+1 NEW ACGI,X
+2 FOR ACGI=1:1:$LENGTH(BY,",")
SET X=$PIECE(BY,",",ACGI)
IF X[26!(X[23)!(X[24)!(X[25)
QUIT
IF X'["+"
SET X="+"_X
SET $PIECE(BY,",",ACGI)=X
+3 QUIT
