Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AQAOPR8

AQAOPR8.m

Go to the documentation of this file. 
  1. AQAOPR8 ; IHS/ORDC/LJF - INDICATOR MATRIX ;
  1.  ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
  1.  ;
  1.  ;This routine contains the user interface for setting up the
  1.  ;Performance Measurement Matrix report
  1.  ;Added in Enhancement #1
  1.  ;
  1.  D MATRIX^AQAOHPRT
  1.  ;
  1. CHOOSE ; -- ask user which grouping to include
  1.  W !! K DIR S DIR(0)="NO^1:3",DIR("B")=3
  1.  S DIR("A",1)="  REPORT CHOICES:"
  1.  S DIR("A",2)=" "
  1.  S DIR("A",3)="  1. KEY FUNCTIONS ONLY"
  1.  S DIR("A",4)="  2. DIMENSIONS OF PERFORMANCE ONLY"
  1.  S DIR("A",5)="  3. INCLUDE BOTH"
  1.  S DIR("A",6)=" "
  1.  S DIR("A")="  Select Which Groupings to include in the Matrix"
  1.  S DIR("?",1)="Choose #1 to print up to 22 Key Functions and their"
  1.  S DIR("?",2)="linked Indicators in a matrix. Select up to 11 Key"
  1.  S DIR("?",3)="Functions to stay within 80 columns."
  1.  S DIR("?",4)=" "
  1.  S DIR("?",5)="Choose #2 for a matrix with only Indicators and"
  1.  S DIR("?",6)="Dimensions of Performance. You can include Review"
  1.  S DIR("?",7)="Criteria with the dimension each one measures."
  1.  S DIR("?",8)=" "
  1.  S DIR("?",9)="Choose #3 to include up to 11 Key Functions plus the"
  1.  S DIR("?",10)="Dimensions of Performance in the matrix. You can also"
  1.  S DIR("?",11)="choose to see the Review Criteria. To stay within"
  1.  S DIR("?",12)="80 columns you can select only 3 Key Functions."
  1.  S DIR("?")=" " F I=1:1:12 S DIR("?",I)="     "_DIR("?",I)
  1.  D ^DIR I $D(DIRUT)!(Y=-1) D EXIT Q
  1.  S AQAOSEL=Y
  1.  ;
  1.  ; -- choose which functions to include
  1.  I AQAOSEL'=2 D FUNCTION I $D(DTOUT)!$D(DUOUT)!'$D(AQAOFNC) D CHOOSE Q
  1.  ;
  1.  ; -- choose whether to include review criteria
  1.  S AQAOCRT=0 I AQAOSEL'=1 D CRITERIA I $D(DIRUT) D CHOOSE Q
  1.  ;
  1.  ; -- calculate right margin for report
  1.  S AQAOIOMX=$S($D(AQAOFNC($$MARGIN80+1)):132,1:80)
  1.  I AQAOIOMX=132 D MSG("Use wide paper or condensed print!")
  1.  ;
  1. DEV ; -- SUBRTN to get print device and call print rtn
  1.  W !! S %ZIS="QP" D ^%ZIS
  1.  I POP D EXIT Q
  1.  I '$D(IO("Q")) D ^AQAOPR81 Q
  1.  K IO("Q") S ZTRTN="^AQAOPR81",ZTDESC="INDICATOR MATRIX"
  1.  F I="AQAOSEL","AQAOFNC(","AQAOCRT","AQAOIOMX" S ZTSAVE(I)=""
  1.  D ^%ZTLOAD K ZTSK D ^%ZISC
  1.  D PRTOPT^AQAOVAR D EXIT Q
  1.  ;
  1.  ;
  1. EXIT ; -- SUBRTN for eoj
  1.  I '$D(ZTQUEUED),(IOST["C-") D PRTOPT^AQAOVAR ;ask to  hit return
  1.  D ^%ZISC D KILL^AQAOUTIL Q
  1.  ;
  1.  ;
  1. FUNCTION ; -- SUBRTN to ask user for functions to include
  1.  NEW AQAOCNT,DIC,X,Y K AQAOFNC S (X,AQAOCNT)=1
  1. F2 S DIC="^AQAO(1,",DIC(0)="AEMQZ"
  1.  F  Q:AQAOCNT>$$MOST  Q:$D(DTOUT)  Q:$D(DUOUT)  Q:X=""  D
  1.  . W ! D ^DIC Q:$D(DTOUT)  Q:$D(DUOUT)  Q:Y=-1
  1.  . S AQAOFNC(AQAOCNT)=+Y_U_Y(0,0)
  1.  . I AQAOCNT=$$MARGIN80 D MSG("Selecting more Functions requires wide paper or condensed print")
  1.  . S AQAOCNT=AQAOCNT+1
  1.  ;
  1.  I AQAOCNT=$$MOST D MSG("You have reached the maximum # of functions that can fit on this report")
  1.  I '$D(AQAOFNC) D MSG("You have NOT selected any Key Functions")
  1.  I $D(AQAOFNC) W !!?3,"You have selected:" D
  1.  . S X=0 F  S X=$O(AQAOFNC(X)) Q:X=""  D
  1.  .. W !?3,$P(AQAOFNC(X),U,2)
  1.  ;
  1.  I AQAOCNT'=$$MOST D  I Y=1 D F2 Q
  1.  . W !! K DIR S DIR(0)="Y",DIR("B")="NO"
  1.  . S DIR("A")="Do you wish to select more Key Functions"
  1.  . D ^DIR
  1.  Q
  1.  ;
  1.  ;
  1. CRITERIA ; -- SUBRTN to ask is criteria should be included in report
  1.  NEW DIR,X,Y S AQAOCRT=0
  1.  S DIR(0)="YO",DIR("B")="NO"
  1.  S DIR("A")="List Review Criteria with each Indicator"
  1.  S DIR("?",1)="Do you wish to list all Review Criteria for each"
  1.  S DIR("?",2)="Clinical Indicator? This shows which review criteria"
  1.  S DIR("?",3)="measure which dimensions of performance."
  1.  S DIR("?")="Answer YES to include review criteria in the matrix."
  1.  W ! D ^DIR I Y=1 S AQAOCRT=1
  1.  Q
  1.  ;
  1.  ;
  1. MOST() ; -- SUBRTN to return # of functions that can fit on this report
  1.  Q $S(AQAOSEL=1:22,1:13)
  1.  ;
  1. MARGIN80() ; -- SUBRTN to return # of functions to fit in 80 columns
  1.  Q $S(AQAOSEL=1:11,1:3)
  1.  ;
  1. MSG(X) ; -- SUBRTN to print warning messages
  1.  W !!?5,*7,X Q