- AQAOPR81 ; IHS/ORDC/LJF - INDICATOR MATRIX CONINUED ;
- ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- ;
- ;This routine prints a list of indicators grouped by the functions
- ;selected by the user and by dimensions of performance if also
- ;selected.
- ;Added for Enhancement #1
- ;
- INIT ; -- initialize variables for report
- S AQAOTY="CLINICAL INDICATOR MATRIX" D INIT^AQAOUTIL
- S X=AQAOIOMX X ^%ZOSF("RM")
- D COVER,NEWPG^AQAOUTIL,HDG2
- ;
- LOOP ; -- loop thru indicators by code number
- S AQAOC=0
- F S AQAOC=$O(^AQAO(2,"B",AQAOC)) Q:AQAOC="" Q:AQAOSTOP=U D
- . S AQAON=0
- . F S AQAON=$O(^AQAO(2,"B",AQAOC,AQAON)) Q:AQAON="" Q:AQAOSTOP=U D
- .. Q:'$D(^AQAO(2,AQAON,0))
- .. Q:$$VAL^XBDIQ1(9002168.2,AQAON,.06)="INACTIVE"
- .. S Y=AQAON D INDCHK^AQAOSEC I '$D(AQAOCHK("OK")) Q ;chk access
- .. I AQAOSEL=1 Q:'$$FNCYES ;not linked to functions selected
- .. I AQAOSEL=2 Q:'$$DIMYES ;not linked to any dimensions
- .. I AQAOSEL=3,'$$FNCYES,'$$DIMYES Q ;not linked to anything
- .. I $Y>(IOSL-3) D NEWPG Q:AQAOSTOP=U D HDG2
- .. W !,AQAOC,?11
- .. I AQAOSEL'=2 D FUNCTION Q:AQAOSTOP=U
- .. I AQAOSEL'=1 D CRITERIA Q:AQAOSTOP=U
- .. D TEAMS Q:AQAOSTOP=U
- .. I AQAOCRT D CRITLIST
- ;
- ;
- EXIT ; -- eoj
- S X=80 X ^%ZOSF("RM")
- I '$D(ZTQUEUED),(IOST["C-") D PRTOPT^AQAOVAR
- D ^%ZISC K AQAOFNC,AQAOSEL,AQAOCRT D KILL^AQAOUTIL
- Q
- ;
- ;
- COVER ; -- SUBRTN to print cover page for report
- D NEWPG^AQAOUTIL
- S X="COVER PAGE" W ?AQAOIOMX-$L(X)\2,X,!,AQAOLINE,!
- ;
- I AQAOSEL'=2 W !!?3,"KEY FUNCTIONS SELECTED:",!
- S AQAOX=0
- F S AQAOX=$O(AQAOFNC(AQAOX)) Q:AQAOX="" D
- . I $Y>(IOSL-3) D NEWPG^AQAOUTIL Q:AQAOSTOP=U W !,AQAOLINE,!
- . W !?3,"F",$E("0"_AQAOX,$L(AQAOX),$L(AQAOX)+1)
- . W ?10,$P(AQAOFNC(AQAOX),U,2)
- ;
- Q:AQAOSEL=1
- W !!?3,"DIMENSIONS OF PERFORMANCE:",!
- F AQAOI=1:1:9 W !?3,"DP",AQAOI,?10,$P($T(DIM+AQAOI),";;",2)
- Q
- ;
- ;
- FUNCTION ; -- SUBRTN to mark which functions indicator is linked to
- NEW AQAOX
- S AQAOX=0 F S AQAOX=$O(AQAOFNC(AQAOX)) Q:AQAOX="" D
- . W " "
- . W $S($D(^AQAO(2,AQAON,"AOC","B",+AQAOFNC(AQAOX))):"X",1:" ")
- . W " "
- Q
- ;
- ;
- CRITERIA ; -- SUBRTN to mark which dimensions indicator is linked to
- NEW AQAOI,X,C
- F AQAOI=1:1:9 D
- . W " "
- . S X=$S($D(^AQAO(2,AQAON,"DIM","B",AQAOI)):"X",1:" ")
- . I X="X" W X," " Q
- . S (X,C)=0
- . F S C=$O(^AQAO1(6,"C",AQAON,C)) Q:C="" Q:X=1 D
- .. W $S($D(^AQAO1(6,C,"DIM","B",AQAOI)):"X",1:" ")," " S X=1
- Q
- ;
- ;
- TEAMS ; -- SUBRTN to print teams linked to indicator
- NEW AQAOX,AQAO,AQAOCOL S AQAOCOL=$X+2
- D ENPM^XBDIQ1(9002168.25,AQAON_",0",.01,"AQAO(","I")
- S AQAOX=0
- F S AQAOX=$O(AQAO(AQAOX)) Q:'AQAOX Q:AQAOSTOP=U D
- . W ?AQAOCOL,$$VALI^XBDIQ1(9002169.1,AQAO(AQAOX,.01,"I"),.02),!
- . I $Y>(IOSL-3) D NEWPG Q:AQAOSTOP=U D HDG2
- Q
- ;
- ;
- CRITLIST ; -- SUBRTN to print review criteria for each indicator
- NEW AQAOX,AQAOD
- S AQAOX=0
- F S AQAOX=$O(^AQAO1(6,"C",AQAON,AQAOX)) Q:AQAOX="" Q:AQAOSTOP=U D
- . W:$X>3 ! W "CR",AQAOX
- .; W $S(AQAOSEL=2:$$VAL^XBDIQ1(9002169.6,AQAOX,.01),1:"CR"_AQAOX)
- . W ?($$HIGHFNC*5+11) ;move to beginning of dimensions columns
- . F AQAOD=1:1:9 D
- .. W " "
- .. W $S($D(^AQAO1(6,"ADIM",AQAOD,AQAOX)):"X",1:" ")," "
- W !
- Q
- ;
- ;
- NEWPG ; -- SUBRTN to call newpage code
- D NEWPG^AQAOUTIL Q
- ;
- ;
- HDG2 ; -- SUBRTN to print 2nd half of heading
- NEW I
- W !,AQAOLIN2,!
- W "Indicators",?11
- I AQAOSEL'=2 F I=1:1:$$HIGHFNC W " F" S:$L(I)=1 I="0"_I W I," "
- I AQAOSEL'=1 F I=1:1:9 W " DP",I," "
- W " QI TEAMS",!,AQAOLINE,!
- Q
- ;
- ;
- FNCYES() ; -- SUBRTN to return whether indicator linked to selected funcs
- NEW X,Y S Y=0
- S X=0 F S X=$O(AQAOFNC(X)) Q:X="" Q:Y=1 D
- . I $D(^AQAO(2,AQAON,"AOC","B",+AQAOFNC(X))) S Y=1
- Q Y
- ;
- ;
- DIMYES() ; -- SUBRTN to return whether indicator linked to any dimensions
- NEW X,Y S Y=0
- I $O(^AQAO(2,AQAON,"DIM",0)) S Y=1
- S X=0 F S X=$O(^AQAO1(6,"C",AQAON,X)) Q:X="" Q:Y=1 D
- . I $O(^AQAO1(6,X,"DIM",0)) S Y=1
- Q Y
- ;
- ;
- HIGHFNC() ; -- SUBRTN to return # of functions selected
- NEW X,Y S (X,Y)=0 F S X=$O(AQAOFNC(X)) Q:X="" S Y=X
- Q Y
- ;
- DIM ;;
- ;;EFFICACY
- ;;APPROPRIATENESS
- ;;AVAILABILITY
- ;;TIMELINESS
- ;;EFFECTIVENESS
- ;;CONTINUITY
- ;;SAFETY
- ;;EFFICIENCY
- ;;RESPECT & CARING
- AQAOPR81 ; IHS/ORDC/LJF - INDICATOR MATRIX CONINUED ;
- +1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- +2 ;
- +3 ;This routine prints a list of indicators grouped by the functions
- +4 ;selected by the user and by dimensions of performance if also
- +5 ;selected.
- +6 ;Added for Enhancement #1
- +7 ;
- INIT ; -- initialize variables for report
- +1 SET AQAOTY="CLINICAL INDICATOR MATRIX"
- DO INIT^AQAOUTIL
- +2 SET X=AQAOIOMX
- XECUTE ^%ZOSF("RM")
- +3 DO COVER
- DO NEWPG^AQAOUTIL
- DO HDG2
- +4 ;
- LOOP ; -- loop thru indicators by code number
- +1 SET AQAOC=0
- +2 FOR
- SET AQAOC=$ORDER(^AQAO(2,"B",AQAOC))
- IF AQAOC=""
- QUIT
- IF AQAOSTOP=U
- QUIT
- Begin DoDot:1
- +3 SET AQAON=0
- +4 FOR
- SET AQAON=$ORDER(^AQAO(2,"B",AQAOC,AQAON))
- IF AQAON=""
- QUIT
- IF AQAOSTOP=U
- QUIT
- Begin DoDot:2
- +5 IF '$DATA(^AQAO(2,AQAON,0))
- QUIT
- +6 IF $$VAL^XBDIQ1(9002168.2,AQAON,.06)="INACTIVE"
- QUIT
- +7 ;chk access
- SET Y=AQAON
- DO INDCHK^AQAOSEC
- IF '$DATA(AQAOCHK("OK"))
- QUIT
- +8 ;not linked to functions selected
- IF AQAOSEL=1
- IF '$$FNCYES
- QUIT
- +9 ;not linked to any dimensions
- IF AQAOSEL=2
- IF '$$DIMYES
- QUIT
- +10 ;not linked to anything
- IF AQAOSEL=3
- IF '$$FNCYES
- IF '$$DIMYES
- QUIT
- +11 IF $Y>(IOSL-3)
- DO NEWPG
- IF AQAOSTOP=U
- QUIT
- DO HDG2
- +12 WRITE !,AQAOC,?11
- +13 IF AQAOSEL'=2
- DO FUNCTION
- IF AQAOSTOP=U
- QUIT
- +14 IF AQAOSEL'=1
- DO CRITERIA
- IF AQAOSTOP=U
- QUIT
- +15 DO TEAMS
- IF AQAOSTOP=U
- QUIT
- +16 IF AQAOCRT
- DO CRITLIST
- End DoDot:2
- End DoDot:1
- +17 ;
- +18 ;
- EXIT ; -- eoj
- +1 SET X=80
- XECUTE ^%ZOSF("RM")
- +2 IF '$DATA(ZTQUEUED)
- IF (IOST["C-")
- DO PRTOPT^AQAOVAR
- +3 DO ^%ZISC
- KILL AQAOFNC,AQAOSEL,AQAOCRT
- DO KILL^AQAOUTIL
- +4 QUIT
- +5 ;
- +6 ;
- COVER ; -- SUBRTN to print cover page for report
- +1 DO NEWPG^AQAOUTIL
- +2 SET X="COVER PAGE"
- WRITE ?AQAOIOMX-$LENGTH(X)\2,X,!,AQAOLINE,!
- +3 ;
- +4 IF AQAOSEL'=2
- WRITE !!?3,"KEY FUNCTIONS SELECTED:",!
- +5 SET AQAOX=0
- +6 FOR
- SET AQAOX=$ORDER(AQAOFNC(AQAOX))
- IF AQAOX=""
- QUIT
- Begin DoDot:1
- +7 IF $Y>(IOSL-3)
- DO NEWPG^AQAOUTIL
- IF AQAOSTOP=U
- QUIT
- WRITE !,AQAOLINE,!
- +8 WRITE !?3,"F",$EXTRACT("0"_AQAOX,$LENGTH(AQAOX),$LENGTH(AQAOX)+1)
- +9 WRITE ?10,$PIECE(AQAOFNC(AQAOX),U,2)
- End DoDot:1
- +10 ;
- +11 IF AQAOSEL=1
- QUIT
- +12 WRITE !!?3,"DIMENSIONS OF PERFORMANCE:",!
- +13 FOR AQAOI=1:1:9
- WRITE !?3,"DP",AQAOI,?10,$PIECE($TEXT(DIM+AQAOI),";;",2)
- +14 QUIT
- +15 ;
- +16 ;
- FUNCTION ; -- SUBRTN to mark which functions indicator is linked to
- +1 NEW AQAOX
- +2 SET AQAOX=0
- FOR
- SET AQAOX=$ORDER(AQAOFNC(AQAOX))
- IF AQAOX=""
- QUIT
- Begin DoDot:1
- +3 WRITE " "
- +4 WRITE $SELECT($DATA(^AQAO(2,AQAON,"AOC","B",+AQAOFNC(AQAOX))):"X",1:" ")
- +5 WRITE " "
- End DoDot:1
- +6 QUIT
- +7 ;
- +8 ;
- CRITERIA ; -- SUBRTN to mark which dimensions indicator is linked to
- +1 NEW AQAOI,X,C
- +2 FOR AQAOI=1:1:9
- Begin DoDot:1
- +3 WRITE " "
- +4 SET X=$SELECT($DATA(^AQAO(2,AQAON,"DIM","B",AQAOI)):"X",1:" ")
- +5 IF X="X"
- WRITE X," "
- QUIT
- +6 SET (X,C)=0
- +7 FOR
- SET C=$ORDER(^AQAO1(6,"C",AQAON,C))
- IF C=""
- QUIT
- IF X=1
- QUIT
- Begin DoDot:2
- +8 WRITE $SELECT($DATA(^AQAO1(6,C,"DIM","B",AQAOI)):"X",1:" ")," "
- SET X=1
- End DoDot:2
- End DoDot:1
- +9 QUIT
- +10 ;
- +11 ;
- TEAMS ; -- SUBRTN to print teams linked to indicator
- +1 NEW AQAOX,AQAO,AQAOCOL
- SET AQAOCOL=$X+2
- +2 DO ENPM^XBDIQ1(9002168.25,AQAON_",0",.01,"AQAO(","I")
- +3 SET AQAOX=0
- +4 FOR
- SET AQAOX=$ORDER(AQAO(AQAOX))
- IF 'AQAOX
- QUIT
- IF AQAOSTOP=U
- QUIT
- Begin DoDot:1
- +5 WRITE ?AQAOCOL,$$VALI^XBDIQ1(9002169.1,AQAO(AQAOX,.01,"I"),.02),!
- +6 IF $Y>(IOSL-3)
- DO NEWPG
- IF AQAOSTOP=U
- QUIT
- DO HDG2
- End DoDot:1
- +7 QUIT
- +8 ;
- +9 ;
- CRITLIST ; -- SUBRTN to print review criteria for each indicator
- +1 NEW AQAOX,AQAOD
- +2 SET AQAOX=0
- +3 FOR
- SET AQAOX=$ORDER(^AQAO1(6,"C",AQAON,AQAOX))
- IF AQAOX=""
- QUIT
- IF AQAOSTOP=U
- QUIT
- Begin DoDot:1
- +4 IF $X>3
- WRITE !
- WRITE "CR",AQAOX
- +5 ; W $S(AQAOSEL=2:$$VAL^XBDIQ1(9002169.6,AQAOX,.01),1:"CR"_AQAOX)
- +6 ;move to beginning of dimensions columns
- WRITE ?($$HIGHFNC*5+11)
- +7 FOR AQAOD=1:1:9
- Begin DoDot:2
- +8 WRITE " "
- +9 WRITE $SELECT($DATA(^AQAO1(6,"ADIM",AQAOD,AQAOX)):"X",1:" ")," "
- End DoDot:2
- End DoDot:1
- +10 WRITE !
- +11 QUIT
- +12 ;
- +13 ;
- NEWPG ; -- SUBRTN to call newpage code
- +1 DO NEWPG^AQAOUTIL
- QUIT
- +2 ;
- +3 ;
- HDG2 ; -- SUBRTN to print 2nd half of heading
- +1 NEW I
- +2 WRITE !,AQAOLIN2,!
- +3 WRITE "Indicators",?11
- +4 IF AQAOSEL'=2
- FOR I=1:1:$$HIGHFNC
- WRITE " F"
- IF $LENGTH(I)=1
- SET I="0"_I
- WRITE I," "
- +5 IF AQAOSEL'=1
- FOR I=1:1:9
- WRITE " DP",I," "
- +6 WRITE " QI TEAMS",!,AQAOLINE,!
- +7 QUIT
- +8 ;
- +9 ;
- FNCYES() ; -- SUBRTN to return whether indicator linked to selected funcs
- +1 NEW X,Y
- SET Y=0
- +2 SET X=0
- FOR
- SET X=$ORDER(AQAOFNC(X))
- IF X=""
- QUIT
- IF Y=1
- QUIT
- Begin DoDot:1
- +3 IF $DATA(^AQAO(2,AQAON,"AOC","B",+AQAOFNC(X)))
- SET Y=1
- End DoDot:1
- +4 QUIT Y
- +5 ;
- +6 ;
- DIMYES() ; -- SUBRTN to return whether indicator linked to any dimensions
- +1 NEW X,Y
- SET Y=0
- +2 IF $ORDER(^AQAO(2,AQAON,"DIM",0))
- SET Y=1
- +3 SET X=0
- FOR
- SET X=$ORDER(^AQAO1(6,"C",AQAON,X))
- IF X=""
- QUIT
- IF Y=1
- QUIT
- Begin DoDot:1
- +4 IF $ORDER(^AQAO1(6,X,"DIM",0))
- SET Y=1
- End DoDot:1
- +5 QUIT Y
- +6 ;
- +7 ;
- HIGHFNC() ; -- SUBRTN to return # of functions selected
- +1 NEW X,Y
- SET (X,Y)=0
- FOR
- SET X=$ORDER(AQAOFNC(X))
- IF X=""
- QUIT
- SET Y=X
- +2 QUIT Y
- +3 ;
- DIM ;;
- +1 ;;EFFICACY
- +2 ;;APPROPRIATENESS
- +3 ;;AVAILABILITY
- +4 ;;TIMELINESS
- +5 ;;EFFECTIVENESS
- +6 ;;CONTINUITY
- +7 ;;SAFETY
- +8 ;;EFFICIENCY
- +9 ;;RESPECT & CARING
