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
