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
