ACMRL3.m

ACMRL3 ; IHS/TUCSON/TMJ - CMS REPORT LISTER...CUSTOM REPORT ; [ 01/07/02  1:14 PM ]

 ;;2.0;ACM CASE MANAGEMENT SYSTEM;**1,4**;JAN 10, 1996

 ;IHS/CMI/LAB - patch 1 flat file

 ;

 ;

TITLE ;EP

 Q:ACMCTYP="F"  ;IHS/CMI/LAB - patch 1 flat file

 Q:ACMCTYP="T"  ;--- don't ask for title if total count only

 K DIR,X,Y S DIR(0)="Y",DIR("A")="Would you like a custom title for this report",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) S ACMQUIT=1 Q

 Q:Y=0

 S ACMLENG=$S(ACMTCW:ACMTCW-8,1:60)

 I Y=1 K DIR,X,Y S DIR(0)="F^3:"_ACMLENG,DIR("A")="Enter custom title",DIR("?")="    Enter from 3 to "_ACMLENG_" characters" D ^DIR K DIR

 G:$D(DIRUT) TITLE

 S ACMTITL=Y

 Q

SAVE ;EP

 Q:$D(ACMCAND)  ;--- don't ask if already a pre-defined rpt

 Q:ACMCTYP'="D"  ;--- must be a detailed report to be saved

 S ACMSAVE=""

 K DIR,X,Y S DIR(0)="Y",DIR("A")="Do you wish to SAVE this "_$S('$D(ACMEP1):"SEARCH/",1:"")_"PRINT/SORT logic for future use",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 Q:'Y

 K DIR,X,Y S DIR(0)="9002258.8,.03",DIR("A")="Enter NAME for this REPORT DEFINITION" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 G:$D(DIRUT) SAVE

 S ACMNAME=Y

 S DIE="^ACM(58.8,",DA=ACMRPT,DR=".02////1;.03///"_ACMNAME_";.06////"_ACMRG_";.05///"_ACMCTYP D ^DIE K DIE,DA,DR

 Q

SCREEN ;EP

 D SMENU^ACMRL2

 W ! S DIR(0)="LO^1:"_ACMHIGH,DIR("A")="      Select Patients based on which of the above" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:Y=""

 I $D(DIRUT) S ACMQUIT=1 Q

 ;process all items in Y

 D SELECT^ACMRL0

 D SHOW^ACMRLS

 W !! S DIR(0)="Y",DIR("A")="      Would you like to select additional PATIENT criteria",DIR("B")="NO" D ^DIR K DIR

 S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) S ACMQUIT=1 Q

 Q:Y=0

 G SCREEN

 ;

COUNT ;EP

 W !! S DIR(0)="S^T:Total Count Only;S:Sub-counts and Total Count;D:Detailed Patient Listing;F:Delimited Export File",DIR("A")="     Choose Type of Report",DIR("B")="D" D ^DIR K DIR W !! ;IHS/CMI/LAB - added delimited

 S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) S ACMQUIT=1 Q

 S ACMCTYP=Y

 I ACMCTYP="T" S $P(^ACM(58.8,ACMRPT,0),U,5)=1 S ACMSORT=2,ACMSORV="Patient Name" Q

 I ACMCTYP="F" D FLAT^ACMRLF Q:$D(ACMQUIT)  D PRINT Q:$D(ACMQUIT)  D SORT Q  ;IHS/CMI/LAB - flat file

 I ACMCTYP="D" D PRINT Q:$D(ACMQUIT)  D SORT Q

 D SORT

 Q

PRINT ;

 D PMENU^ACMRL2

 S DIR(0)="LO^1:"_ACMHIGH,DIR("A")="Select print item(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:Y=""

 I $D(DIRUT) S ACMQUIT=1 Q

 I ACMCTYP="P" W !!?15,"Total Report width (including column margins - 2 spaces):  ",ACMTCW ;IHS/CMI/LAB - flat file

 D PSELECT^ACMRL0

 D SHOWP^ACMRLS

 W !! S DIR(0)="Y",DIR("A")="      Would you like to select additional PRINT criteria",DIR("B")="NO" D ^DIR K DIR

 S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) S ACMQUIT=1 Q

 Q:Y=0

 G PRINT

SORT ;

 K ACMSORT,ACMSORV,ACMQUIT

 I ACMCTYP="D",'$D(^ACM(58.8,ACMRPT,12)) W !!,"NO PRINT FIELDS SELECTED!!",$C(7),$C(7) S ACMQUIT=1 Q

 S ACMSORT=""

 D SHOWR^ACMRLS

 D RMENU^ACMRL2

 W ! S DIR(0)="NO^1:"_ACMHIGH_":0",DIR("A")=$S(ACMCTYP="S":"Sub-total ",1:"Sort ")_"Patients by which of the above" D ^DIR K DIR

 I $D(DUOUT) K ^ACM(58.8,ACMRPT,12) S ACMTCW=0 G PRINT

 I Y="",(ACMCTYP="D"!(ACMCTYP="F")) W !!,"No sort criteria selected ... will sort by Patient Name" S ACMSORT=2,ACMSORV="Patient Name" H 4 D  Q  ;IHS/CMI/LAB

 .S DA=ACMRPT,DIE="^ACM(58.8,",DR=".07////"_ACMSORT D ^DIE K DA,DR,DIE,DIU,DIV,DIY,DIW

 I Y="",ACMCTYP'="D" W !!,"No sub-totalling will be done.",!! H 4 S ACMCTYP="T",ACMSORT=2 Q

 S ACMSORT=ACMSEL(+Y),ACMSORV=$P(^ACM(58.1,ACMSORT,0),U),DA=ACMRPT,DIE="^ACM(58.8,",DR=".07////"_ACMSORT D ^DIE K DA,DR,DIE,DIU,DIV,DIY,DIW

 Q:ACMCTYP'="D"

PAGE ;

 K ACMSPAG

 Q:ACMCTYP'="D"

 S DIR(0)="Y",DIR("A")="Do you want a separate page for each "_ACMSORV,DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G SORT

 S ACMSPAG=Y,DIE="^ACM(58.8,",DA=ACMRPT,DR=".04///"_ACMSPAG D ^DIE K DA,DR,DIE

 Q

ACMRL3    ; IHS/TUCSON/TMJ - CMS REPORT LISTER...CUSTOM REPORT ; [ 01/07/02  1:14 PM ]

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

 +2       ;IHS/CMI/LAB - patch 1 flat file

 +3       ;

 +4       ;

TITLE     ;EP

 +1       ;IHS/CMI/LAB - patch 1 flat file

           IF ACMCTYP="F"

               QUIT 

 +2       ;--- don't ask for title if total count only

           IF ACMCTYP="T"

               QUIT 

 +3        KILL DIR,X,Y

           SET DIR(0)="Y"

           SET DIR("A")="Would you like a custom title for this report"

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $DATA(DIRUT)

               SET ACMQUIT=1

               QUIT 

 +5        IF Y=0

               QUIT 

 +6        SET ACMLENG=$SELECT(ACMTCW:ACMTCW-8,1:60)

 +7        IF Y=1

               KILL DIR,X,Y

               SET DIR(0)="F^3:"_ACMLENG

               SET DIR("A")="Enter custom title"

               SET DIR("?")="    Enter from 3 to "_ACMLENG_" characters"

               DO ^DIR

               KILL DIR

 +8        IF $DATA(DIRUT)

               GOTO TITLE

 +9        SET ACMTITL=Y

 +10       QUIT 

SAVE      ;EP

 +1       ;--- don't ask if already a pre-defined rpt

           IF $DATA(ACMCAND)

               QUIT 

 +2       ;--- must be a detailed report to be saved

           IF ACMCTYP'="D"

               QUIT 

 +3        SET ACMSAVE=""

 +4        KILL DIR,X,Y

           SET DIR(0)="Y"

           SET DIR("A")="Do you wish to SAVE this "_$SELECT('$DATA(ACMEP1):"SEARCH/",1:"")_"PRINT/SORT logic for future use"

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +5        IF $DATA(DIRUT)

               QUIT 

 +6        IF 'Y

               QUIT 

 +7        KILL DIR,X,Y

           SET DIR(0)="9002258.8,.03"

           SET DIR("A")="Enter NAME for this REPORT DEFINITION"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +8        IF $DATA(DIRUT)

               GOTO SAVE

 +9        SET ACMNAME=Y

 +10       SET DIE="^ACM(58.8,"

           SET DA=ACMRPT

           SET DR=".02////1;.03///"_ACMNAME_";.06////"_ACMRG_";.05///"_ACMCTYP

           DO ^DIE

           KILL DIE,DA,DR

 +11       QUIT 

SCREEN    ;EP

 +1        DO SMENU^ACMRL2

 +2        WRITE !

           SET DIR(0)="LO^1:"_ACMHIGH

           SET DIR("A")="      Select Patients based on which of the above"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF Y=""

               QUIT 

 +4        IF $DATA(DIRUT)

               SET ACMQUIT=1

               QUIT 

 +5       ;process all items in Y

 +6        DO SELECT^ACMRL0

 +7        DO SHOW^ACMRLS

 +8        WRITE !!

           SET DIR(0)="Y"

           SET DIR("A")="      Would you like to select additional PATIENT criteria"

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

 +9        IF $DATA(DUOUT)

               SET DIRUT=1

 +10       IF $DATA(DIRUT)

               SET ACMQUIT=1

               QUIT 

 +11       IF Y=0

               QUIT 

 +12       GOTO SCREEN

 +13      ;

COUNT     ;EP

 +1       ;IHS/CMI/LAB - added delimited

           WRITE !!

           SET DIR(0)="S^T:Total Count Only;S:Sub-counts and Total Count;D:Detailed Patient Listing;F:Delimited Export File"

           SET DIR("A")="     Choose Type of Report"

           SET DIR("B")="D"

           DO ^DIR

           KILL DIR

           WRITE !!

 +2        IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               SET ACMQUIT=1

               QUIT 

 +4        SET ACMCTYP=Y

 +5        IF ACMCTYP="T"

               SET $PIECE(^ACM(58.8,ACMRPT,0),U,5)=1

               SET ACMSORT=2

               SET ACMSORV="Patient Name"

               QUIT 

 +6       ;IHS/CMI/LAB - flat file

           IF ACMCTYP="F"

               DO FLAT^ACMRLF

               IF $DATA(ACMQUIT)

                   QUIT 

               DO PRINT

               IF $DATA(ACMQUIT)

                   QUIT 

               DO SORT

               QUIT 

 +7        IF ACMCTYP="D"

               DO PRINT

               IF $DATA(ACMQUIT)

                   QUIT 

               DO SORT

               QUIT 

 +8        DO SORT

 +9        QUIT 

PRINT     ;

 +1        DO PMENU^ACMRL2

 +2        SET DIR(0)="LO^1:"_ACMHIGH

           SET DIR("A")="Select print item(s)"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF Y=""

               QUIT 

 +4        IF $DATA(DIRUT)

               SET ACMQUIT=1

               QUIT 

 +5       ;IHS/CMI/LAB - flat file

           IF ACMCTYP="P"

               WRITE !!?15,"Total Report width (including column margins - 2 spaces):  ",ACMTCW

 +6        DO PSELECT^ACMRL0

 +7        DO SHOWP^ACMRLS

 +8        WRITE !!

           SET DIR(0)="Y"

           SET DIR("A")="      Would you like to select additional PRINT criteria"

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

 +9        IF $DATA(DUOUT)

               SET DIRUT=1

 +10       IF $DATA(DIRUT)

               SET ACMQUIT=1

               QUIT 

 +11       IF Y=0

               QUIT 

 +12       GOTO PRINT

SORT      ;

 +1        KILL ACMSORT,ACMSORV,ACMQUIT

 +2        IF ACMCTYP="D"

               IF '$DATA(^ACM(58.8,ACMRPT,12))

                   WRITE !!,"NO PRINT FIELDS SELECTED!!",$CHAR(7),$CHAR(7)

                   SET ACMQUIT=1

                   QUIT 

 +3        SET ACMSORT=""

 +4        DO SHOWR^ACMRLS

 +5        DO RMENU^ACMRL2

 +6        WRITE !

           SET DIR(0)="NO^1:"_ACMHIGH_":0"

           SET DIR("A")=$SELECT(ACMCTYP="S":"Sub-total ",1:"Sort ")_"Patients by which of the above"

           DO ^DIR

           KILL DIR

 +7        IF $DATA(DUOUT)

               KILL ^ACM(58.8,ACMRPT,12)

               SET ACMTCW=0

               GOTO PRINT

 +8       ;IHS/CMI/LAB

           IF Y=""

               IF (ACMCTYP="D"!(ACMCTYP="F"))

                   WRITE !!,"No sort criteria selected ... will sort by Patient Name"

                   SET ACMSORT=2

                   SET ACMSORV="Patient Name"

                   HANG 4

                   Begin DoDot:1

 +9                    SET DA=ACMRPT

                       SET DIE="^ACM(58.8,"

                       SET DR=".07////"_ACMSORT

                       DO ^DIE

                       KILL DA,DR,DIE,DIU,DIV,DIY,DIW

                   End DoDot:1

                   QUIT 

 +10       IF Y=""

               IF ACMCTYP'="D"

                   WRITE !!,"No sub-totalling will be done.",!!

                   HANG 4

                   SET ACMCTYP="T"

                   SET ACMSORT=2

                   QUIT 

 +11       SET ACMSORT=ACMSEL(+Y)

           SET ACMSORV=$PIECE(^ACM(58.1,ACMSORT,0),U)

           SET DA=ACMRPT

           SET DIE="^ACM(58.8,"

           SET DR=".07////"_ACMSORT

           DO ^DIE

           KILL DA,DR,DIE,DIU,DIV,DIY,DIW

 +12       IF ACMCTYP'="D"

               QUIT 

PAGE      ;

 +1        KILL ACMSPAG

 +2        IF ACMCTYP'="D"

               QUIT 

 +3        SET DIR(0)="Y"

           SET DIR("A")="Do you want a separate page for each "_ACMSORV

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $DATA(DIRUT)

               GOTO SORT

 +5        SET ACMSPAG=Y

           SET DIE="^ACM(58.8,"

           SET DA=ACMRPT

           SET DR=".04///"_ACMSPAG

           DO ^DIE

           KILL DA,DR,DIE

 +6        QUIT