Routine: ACMSRT2

ACMSRT2 ; IHS/TUCSON/TMJ - GETS SORT INFOR FOR CNSR ;

 ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996

 ;EP;ENTRY POINT:

EN D SET,INIT:'$D(ACMQUIT),MENU:'$D(ACMQUIT)

SET S ACMRPT=$P(ACMENTRY,";;",2),ACMPTMP=$O(^DIPT("B","ACM "_ACMRPT,""))

 I '$D(ACMPTMP)!(ACMPTMP="") S ACMQUIT="" Q

 S ACMFILE=$P(ACMENTRY,";;",3),ACMDIC="^ACM("_ACMFILE_","

INIT S FLDS="[`"_ACMPTMP_"]",FR="",TO="",ACMN=1,ACMMAND=99,ACMCSTG="^99^"

 S:'$D(BY) BY="" I BY'["EDITED NOT PRINTED" S BY=""

MENU S ACMYX="",ACMYI=0

 F  S ACMYX=$O(^ACM(48.5,"B",ACMYX)) Q:ACMYX=""  S ACMYY=0 F  S ACMYY=$O(^ACM(48.5,"B",ACMYX,ACMYY)) Q:'ACMYY!($D(ACMDM)&(ACMYX="REGISTER"))  I $D(^ACM(48.5,ACMYY,2,"B",ACMPTMP)) D M1

W !

M1 N ACMYZ

 S ACMYZ=$O(^ACM(48.5,ACMYY,2,"B",ACMPTMP,"")),ACMYZ=^(ACMYZ)

 ;S ACMYI=ACMYI+1,ACMUB(ACMYY)=ACMYY_U_ACMYX_U_ACMYZ

 S ACMYI=ACMYI+1,ACMUB(ACMYI)=ACMYY_U_ACMYX_U_ACMYZ

ACMSRT2   ; IHS/TUCSON/TMJ - GETS SORT INFOR FOR CNSR ;

 +1       ;;2.0;ACM CASE MANAGEMENT SYSTEM;;JAN 10, 1996

 +2       ;EP;ENTRY POINT:

EN         DO SET

           IF '$DATA(ACMQUIT)

               DO INIT

           IF '$DATA(ACMQUIT)

               DO MENU

 +1        QUIT

SET        SET ACMRPT=$PIECE(ACMENTRY,";;",2)

           SET ACMPTMP=$ORDER(^DIPT("B","ACM "_ACMRPT,""))

 +1        IF '$DATA(ACMPTMP)!(ACMPTMP="")

               SET ACMQUIT=""

               QUIT

 +2        SET ACMFILE=$PIECE(ACMENTRY,";;",3)

           SET ACMDIC="^ACM("_ACMFILE_","

 +3        QUIT

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

           SET FR=""

           SET TO=""

           SET ACMN=1

           SET ACMMAND=99

           SET ACMCSTG="^99^"

 +1        IF '$DATA(BY)

               SET BY=""

           IF BY'["EDITED NOT PRINTED"

               SET BY=""

 +2        QUIT

MENU       SET ACMYX=""

           SET ACMYI=0

 +1        FOR

               SET ACMYX=$ORDER(^ACM(48.5,"B",ACMYX))

               IF ACMYX=""

                   QUIT

               SET ACMYY=0

FOR

                   SET ACMYY=$ORDER(^ACM(48.5,"B",ACMYX,ACMYY))

                   IF 'ACMYY!($DATA(ACMDM)&(ACMYX="REGISTER"))

                       QUIT

                   IF $DATA(^ACM(48.5,ACMYY,2,"B",ACMPTMP))

                       DO M1

 +2        WRITE !

 +3        QUIT

M1         NEW ACMYZ

 +1        SET ACMYZ=$ORDER(^ACM(48.5,ACMYY,2,"B",ACMPTMP,""))

           SET ACMYZ=^(ACMYZ)

 +2       ;S ACMYI=ACMYI+1,ACMUB(ACMYY)=ACMYY_U_ACMYX_U_ACMYZ

 +3        SET ACMYI=ACMYI+1

           SET ACMUB(ACMYI)=ACMYY_U_ACMYX_U_ACMYZ

 +4        QUIT

ACMSRT2.m