ACGSRT2.m

ACGSRT2 ;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 D SET,INIT:'$D(ACGQUIT),MENU:'$D(ACGQUIT)

 Q

SET S ACGRPT="SUMMARY" ;$P(ACGENTRY,";;",2)

 S ACGPTMP=$O(^DIPT("B","ACG "_ACGRPT,""))

 I '$D(ACGPTMP)!(ACGPTMP="") S ACGQUIT="" Q

 S ACGFILE="^ACGS(" ;$P(ACGENTRY,";;",3)

 S ACGDIC=ACGFILE

 Q

INIT S FLDS="[`"_ACGPTMP_"]",FR="",TO="",ACGN=1,ACGMAND=99,ACGCSTG="^99^"

 S:'$D(BY) BY=""

 Q

MENU S ACGYX="",ACGYI=0 F  S ACGYX=$O(^ACGSRT("B",ACGYX)) Q:ACGYX=""  F ACGYY=0:0 S ACGYY=$O(^ACGSRT("B",ACGYX,ACGYY)) Q:'ACGYY  I $D(^ACGSRT(ACGYY,2,"B",ACGPTMP)) D M1

 W !

 Q

M1 N ACGYZ

 S ACGYZ=$O(^ACGSRT(ACGYY,2,"B",ACGPTMP,"")),ACGYZ=^(ACGYZ)

 S ACGYI=ACGYI+1,ACGUB(ACGYI)=ACGYY_U_ACGYX_U_ACGYZ

 Q

ACGSRT2   ;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         DO SET

           IF '$DATA(ACGQUIT)

               DO INIT

           IF '$DATA(ACGQUIT)

               DO MENU

 +1        QUIT 

SET       ;$P(ACGENTRY,";;",2)

           SET ACGRPT="SUMMARY"

 +1        SET ACGPTMP=$ORDER(^DIPT("B","ACG "_ACGRPT,""))

 +2        IF '$DATA(ACGPTMP)!(ACGPTMP="")

               SET ACGQUIT=""

               QUIT 

 +3       ;$P(ACGENTRY,";;",3)

           SET ACGFILE="^ACGS("

 +4        SET ACGDIC=ACGFILE

 +5        QUIT 

INIT       SET FLDS="[`"_ACGPTMP_"]"

           SET FR=""

           SET TO=""

           SET ACGN=1

           SET ACGMAND=99

           SET ACGCSTG="^99^"

 +1        IF '$DATA(BY)

               SET BY=""

 +2        QUIT 

MENU       SET ACGYX=""

           SET ACGYI=0

           FOR 

               SET ACGYX=$ORDER(^ACGSRT("B",ACGYX))

               IF ACGYX=""

                   QUIT 

               FOR ACGYY=0:0

                   SET ACGYY=$ORDER(^ACGSRT("B",ACGYX,ACGYY))

                   IF 'ACGYY

                       QUIT 

                   IF $DATA(^ACGSRT(ACGYY,2,"B",ACGPTMP))

                       DO M1

 +1        WRITE !

 +2        QUIT 

M1         NEW ACGYZ

 +1        SET ACGYZ=$ORDER(^ACGSRT(ACGYY,2,"B",ACGPTMP,""))

           SET ACGYZ=^(ACGYZ)

 +2        SET ACGYI=ACGYI+1

           SET ACGUB(ACGYI)=ACGYY_U_ACGYX_U_ACGYZ

 +3        QUIT