- 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