AQAOPC9 ; IHS/ORDC/LJF - OCC REPORTS WITH XTRA SORT ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn is the driver for the trending report by special review
;type. This report adds an additional sort onto the 3 main trending
;reports available. ONce the extra sort is selected, the user is
;dropped into one of those report rtns.
;
D REVT^AQAOHOP3 ;intro text
SORT ; >>> ask user to choose which sort category to use
W !! K DIC S DIC(0)="AEMZQ",DIC("A")="Choose a SORT CATEGORY: "
S DIC=9002169.9,DIC("S")="X ^AQAO1(9,Y,""DSPLY"")"
D ^DIC G EXIT:$D(DUOUT),EXIT:X="",SORT:Y=-1
S AQAOXSN=+Y,AQAOXSM=$P(Y,U,2)
;
ALL ; >>> ask if all sort values should be included in report
W !! K DIR S DIR(0)="YO",DIR("B")="NO"
S DIR("A")="Print Occurrences for ALL "_AQAOXSM D ^DIR
Q:$D(DIRUT) G ALL:Y=-1 I Y=1 S AQAOXS(0)="" G REPORT
;
SELECT ; >> ask user to choose which values to include
; code used determined by sort type
S AQAOTYP=$P(^AQAO1(9,AQAOXSN,0),U,2)
S X=$S(AQAOTYP="N":"NUMBER",AQAOTYP="S":"CODES",1:"POINTER") D @X
I '$D(AQAOXS) G SORT
I $G(^AQAO1(9,AQAOXSN,"DIRO"))]"" D XTRASCRN G SORT:'$D(AQAOXS(2))
;
REPORT ; >>> ask user to select report to run
W !! K DIR S DIR(0)="NO^1:4"
S DIR("A")="Select REPORT to print"
F I=1:1:4 S DIR("A",I)=I_". "_$P($T(RTN+I),";;",2)
S DIR("A",5)=" " D ^DIR G EXIT:$D(DTOUT),SORT:$D(DIRUT),REPORT:Y=-1
S AQAORTN=$P($T(RTN+Y),";;",3) D @AQAORTN
;
EXIT ; >>> eoj
D KILL^AQAOUTIL Q
;
;
POINTER ; >> SUBRTN to ask pointer values to include
S AQAOI=0,AQAOSTOP="" K AQAOXS(1)
F S AQAOI=$O(^AQAO1(9,AQAOXSN,"PTR",AQAOI)) Q:AQAOI'=+AQAOI D
.S AQAOJ=$P(^AQAO1(9,AQAOXSN,"PTR",AQAOI,0),U) ;ptr file number
.K DIC S DIC=AQAOJ,DIC(0)="AEMQZ"
.S Y=0 F D Q:Y=-1 ;continue until all user wants are selected
..W ! D ^DIC Q:$D(DTOUT) Q:$D(DUOUT) Q:X="" Q:Y=-1
..S:AQAOTYP="V" AQAOXS(1,+Y_";"_$P(^DIC(AQAOJ,0,"GL"),U,2))=$P(Y,U,2)
..S:AQAOTYP="P" AQAOXS(1,+Y)=$P(Y,U,2)
Q
;
NUMBER ; >> SUBRTN to ask for number ranges to include
Q
;
CODES ; >> SUBRTN to ask for code values to include
Q
;
XTRASCRN ; >> SUBRTN to ask for xtra screen if one defined for sort
K AQAOXS(2) W !!,"For the ",AQAOXSM," selected,",!
K DIR S DIR("A")="Choose ONE"
S X=^AQAO1(9,AQAOXSN,"DIR0") X X ;sets DIR(0)
S X=0 F S X=$O(^AQAO1(9,AQAOXSN,"DIRA",X)) Q:X'=+X D
.S DIR("A",X)=^AQAO1(9,AQAOXSN,"DIRA",X,0) ;set DIR(A,#)
D ^DIR Q:$D(DIRUT) G XTRASCRN:Y=-1
S AQAOXS(2)=Y
Q
;
RTN ;;
;;Occurrences By REVIEW CRITERIA;;^AQAOPC1
;;Occurrences By DIAGNOSIS/PROCEDURE;;^AQAOPC2
;;Occurrences By FINDINGS/ACTIONS;;^AQAOPC4
;;Occurrences for SINGLE CRITERION by MONTH;;^AQAOPC7
AQAOPC9 ; IHS/ORDC/LJF - OCC REPORTS WITH XTRA SORT ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn is the driver for the trending report by special review
+4 ;type. This report adds an additional sort onto the 3 main trending
+5 ;reports available. ONce the extra sort is selected, the user is
+6 ;dropped into one of those report rtns.
+7 ;
+8 ;intro text
DO REVT^AQAOHOP3
SORT ; >>> ask user to choose which sort category to use
+1 WRITE !!
KILL DIC
SET DIC(0)="AEMZQ"
SET DIC("A")="Choose a SORT CATEGORY: "
+2 SET DIC=9002169.9
SET DIC("S")="X ^AQAO1(9,Y,""DSPLY"")"
+3 DO ^DIC
IF $DATA(DUOUT)
GOTO EXIT
IF X=""
GOTO EXIT
IF Y=-1
GOTO SORT
+4 SET AQAOXSN=+Y
SET AQAOXSM=$PIECE(Y,U,2)
+5 ;
ALL ; >>> ask if all sort values should be included in report
+1 WRITE !!
KILL DIR
SET DIR(0)="YO"
SET DIR("B")="NO"
+2 SET DIR("A")="Print Occurrences for ALL "_AQAOXSM
DO ^DIR
+3 IF $DATA(DIRUT)
QUIT
IF Y=-1
GOTO ALL
IF Y=1
SET AQAOXS(0)=""
GOTO REPORT
+4 ;
SELECT ; >> ask user to choose which values to include
+1 ; code used determined by sort type
+2 SET AQAOTYP=$PIECE(^AQAO1(9,AQAOXSN,0),U,2)
+3 SET X=$SELECT(AQAOTYP="N":"NUMBER",AQAOTYP="S":"CODES",1:"POINTER")
DO @X
+4 IF '$DATA(AQAOXS)
GOTO SORT
+5 IF $GET(^AQAO1(9,AQAOXSN,"DIRO"))]""
DO XTRASCRN
IF '$DATA(AQAOXS(2))
GOTO SORT
+6 ;
REPORT ; >>> ask user to select report to run
+1 WRITE !!
KILL DIR
SET DIR(0)="NO^1:4"
+2 SET DIR("A")="Select REPORT to print"
+3 FOR I=1:1:4
SET DIR("A",I)=I_". "_$PIECE($TEXT(RTN+I),";;",2)
+4 SET DIR("A",5)=" "
DO ^DIR
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DIRUT)
GOTO SORT
IF Y=-1
GOTO REPORT
+5 SET AQAORTN=$PIECE($TEXT(RTN+Y),";;",3)
DO @AQAORTN
+6 ;
EXIT ; >>> eoj
+1 DO KILL^AQAOUTIL
QUIT
+2 ;
+3 ;
POINTER ; >> SUBRTN to ask pointer values to include
+1 SET AQAOI=0
SET AQAOSTOP=""
KILL AQAOXS(1)
+2 FOR
SET AQAOI=$ORDER(^AQAO1(9,AQAOXSN,"PTR",AQAOI))
IF AQAOI'=+AQAOI
QUIT
Begin DoDot:1
+3 ;ptr file number
SET AQAOJ=$PIECE(^AQAO1(9,AQAOXSN,"PTR",AQAOI,0),U)
+4 KILL DIC
SET DIC=AQAOJ
SET DIC(0)="AEMQZ"
+5 ;continue until all user wants are selected
SET Y=0
FOR
Begin DoDot:2
+6 WRITE !
DO ^DIC
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
IF X=""
QUIT
IF Y=-1
QUIT
+7 IF AQAOTYP="V"
SET AQAOXS(1,+Y_";"_$PIECE(^DIC(AQAOJ,0,"GL"),U,2))=$PIECE(Y,U,2)
+8 IF AQAOTYP="P"
SET AQAOXS(1,+Y)=$PIECE(Y,U,2)
End DoDot:2
IF Y=-1
QUIT
End DoDot:1
+9 QUIT
+10 ;
NUMBER ; >> SUBRTN to ask for number ranges to include
+1 QUIT
+2 ;
CODES ; >> SUBRTN to ask for code values to include
+1 QUIT
+2 ;
XTRASCRN ; >> SUBRTN to ask for xtra screen if one defined for sort
+1 KILL AQAOXS(2)
WRITE !!,"For the ",AQAOXSM," selected,",!
+2 KILL DIR
SET DIR("A")="Choose ONE"
+3 ;sets DIR(0)
SET X=^AQAO1(9,AQAOXSN,"DIR0")
XECUTE X
+4 SET X=0
FOR
SET X=$ORDER(^AQAO1(9,AQAOXSN,"DIRA",X))
IF X'=+X
QUIT
Begin DoDot:1
+5 ;set DIR(A,#)
SET DIR("A",X)=^AQAO1(9,AQAOXSN,"DIRA",X,0)
End DoDot:1
+6 DO ^DIR
IF $DATA(DIRUT)
QUIT
IF Y=-1
GOTO XTRASCRN
+7 SET AQAOXS(2)=Y
+8 QUIT
+9 ;
RTN ;;
+1 ;;Occurrences By REVIEW CRITERIA;;^AQAOPC1
+2 ;;Occurrences By DIAGNOSIS/PROCEDURE;;^AQAOPC2
+3 ;;Occurrences By FINDINGS/ACTIONS;;^AQAOPC4
+4 ;;Occurrences for SINGLE CRITERION by MONTH;;^AQAOPC7
