ACGSRT.m

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