AQAOPU1 ; IHS/ORDC/LJF - INDICATOR SELECTION ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn contains an extrinsic function called by various reports
;to select facility-defined report format. These formats contain a
;defined set of grouped indicators.
;
FACR(AQAOSUB) ;ENTRY POINT EXTR FUNC - select facility specific report to run
K ^TMP(AQAOSUB,$J) ;PATCH 1
S AQAOTYP=Y ;set report type
;
; >> user gets choice of facilities if user has access >1 site
S AQAOFAC=DUZ(2),X=$O(^VA(200,DUZ,2,0)) I X]"" D
.S X=$O(^VA(200,DUZ,2,X)) I X]"" D
..W !! K DIC S DIC="^AQAGP(",DIC(0)="AEMZQ"
..S DIC("A")="Select FACILITY first: " D ^DIC
..I Y<1 S AQAOTYP=U
..E S AQAOFAC=+Y
I AQAOTYP=U Q AQAOTYP
;
; >> user selects report format
I '$D(^AQAGP(AQAOFAC,"FACRPT",0)) S ^(0)="^9002166.41"
W !! K DIC,DA S DIC="^AQAGP("_AQAOFAC_",""FACRPT"",",DIC(0)="AEMZQ"
S DIC("S")="I '$O(^AQAGP(AQAOFAC,""FACRPT"",Y,""RES"",0))!$D(^AQAGP(AQAOFAC,""FACRPT"",Y,""RES"",""B"",DUZ))" ;PATCH 1
S DA(1)=AQAOFAC D ^DIC I Y<1 S AQAOTYP=U Q AQAOTYP
S AQAORPT=Y ;report name & number
S AQAORPTT=$P(^AQAGP(AQAOFAC,"FACRPT",+AQAORPT,0),U,2) ;report title
;
; >> find contents of report selected
F AQAOI="MSF","HW","KF","IND","DIM" D
.S AQAOX=0 ;for each heading, find indicators
.F S AQAOX=$O(^AQAGP(AQAOFAC,"FACRPT",+AQAORPT,AQAOI,AQAOX)) Q:AQAOX'=+AQAOX D
..Q:'$D(^AQAGP(AQAOFAC,"FACRPT",+AQAORPT,AQAOI,AQAOX,0)) S AQAOS=+^(0)
..I (AQAOI="HW")!(AQAOI="IND") S Y=AQAOS D INDCHK^AQAOPU,SET Q
..;
..I AQAOI="DIM" D DIMCHK Q
..S AQAOC=$S(AQAOI="MSF":"AD",1:"AB") ;xref in qi ind file
..S Y=0 F S Y=$O(^AQAO(2,AQAOC,AQAOS,Y)) Q:Y="" D INDCHK^AQAOPU,SET
;
; >> display indicators included in report
D DISPLAY
;
Q AQAOTYP
;
;
SET ; >> SUBRTN to set indicator array
I (AQAOI="MSF")!(AQAOI="KF") Q:$G(AQAOCHK("OK"))="I" ;inactive ind
I AQAOI="HW" S AQAOF="FACILITY WIDE INDICATORS" ;PATCH 2
I AQAOI="IND" S AQAOF="OTHER INDICATORS"
I AQAOI="KF" S AQAOF="KEY FUNCTION - "_$P(^AQAO(1,AQAOS,0),U)
I AQAOI="MSF" D
.S AQAOZ=Y,Y=AQAOS,C=$P(^DD(9002168.2,.13,0),U,2) D Y^DIQ
.S AQAOF="MED STAFF FUNCTION - "_Y,Y=AQAOZ
I AQAOI="DIM" S AQAOF="DIMENSION - "_$P($T(DIM+AQAOS),";;",2) ;ENH1
I $D(AQAOCHK("OK")) S ^TMP(AQAOSUB,$J,1,AQAOF,Y)=""
E S ^TMP(AQAOSUB,$J,2,$P(^AQAO(2,Y,0),U))=""
Q
;
;
DISPLAY ; >> SUBRTN to display indicators found for report
S X="Facility Specific Report: "_$P(AQAORPT,U,2) W @IOF,!!,X
W !!,"Indicators To Be Included In This Report:"
I '$D(^TMP(AQAOSUB,$J,1)) W !!,"NONE FOUND" S AQAOTYP=U G DSPLY9
S X=0 F S X=$O(^TMP(AQAOSUB,$J,1,X)) Q:X="" Q:$G(AQAOSTOP)=U D
.W !!,"HEADING: ",X
.S Y=0 F S Y=$O(^TMP(AQAOSUB,$J,1,X,Y)) Q:Y="" Q:$G(AQAOSTOP)=U D
..W !?9,$P(^AQAO(2,Y,0),U),?20,$P(^(0),U,2)
..I $Y>(IOSL-4) S AQAOSTOP=$$EOP^AQAOPU Q:AQAOSTOP=U
I $D(^TMP(AQAOSUB,$J,2)) D
.W !!,"Indicators NOT To Be Included: (You do not have access to them)"
.S X=0 F S X=$O(^TMP(AQAOSUB,$J,2,X)) Q:X="" D
..W !?5,X
..I $Y>(IOSL-4) S AQAOSTOP=$$EOP^AQAOPU Q:AQAOSTOP=U
DSPLY9 W !! K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR
Q
;
;
DIMCHK ; -- SUBRTN to find indicators tied to dimension
NEW Y,X S Y=0
F S Y=$O(^AQAO(2,"ADIM",AQAOS,Y)) Q:Y="" D INDCHK^AQAOPU,SET
S X=0
F S X=$O(^AQAO1(6,"ADIM",AQAOS,X)) Q:X="" D
. S Y=0
. F S Y=$O(^AQAO1(6,X,"IND","B",Y)) Q:Y="" D INDCHK^AQAOPU,SET
Q
;
;
DIM ;;
;;EFFICACY
;;APPROPRIATENESS
;;AVAILABILITY
;;TIMELINESS
;;EFFECTIVENESS
;;CONTINUITY
;;SAFETY
;;EFFICIENCY
;;RESPECT & CARING
AQAOPU1 ; IHS/ORDC/LJF - INDICATOR SELECTION ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn contains an extrinsic function called by various reports
+4 ;to select facility-defined report format. These formats contain a
+5 ;defined set of grouped indicators.
+6 ;
FACR(AQAOSUB) ;ENTRY POINT EXTR FUNC - select facility specific report to run
+1 ;PATCH 1
KILL ^TMP(AQAOSUB,$JOB)
+2 ;set report type
SET AQAOTYP=Y
+3 ;
+4 ; >> user gets choice of facilities if user has access >1 site
+5 SET AQAOFAC=DUZ(2)
SET X=$ORDER(^VA(200,DUZ,2,0))
IF X]""
Begin DoDot:1
+6 SET X=$ORDER(^VA(200,DUZ,2,X))
IF X]""
Begin DoDot:2
+7 WRITE !!
KILL DIC
SET DIC="^AQAGP("
SET DIC(0)="AEMZQ"
+8 SET DIC("A")="Select FACILITY first: "
DO ^DIC
+9 IF Y<1
SET AQAOTYP=U
+10 IF '$TEST
SET AQAOFAC=+Y
End DoDot:2
End DoDot:1
+11 IF AQAOTYP=U
QUIT AQAOTYP
+12 ;
+13 ; >> user selects report format
+14 IF '$DATA(^AQAGP(AQAOFAC,"FACRPT",0))
SET ^(0)="^9002166.41"
+15 WRITE !!
KILL DIC,DA
SET DIC="^AQAGP("_AQAOFAC_",""FACRPT"","
SET DIC(0)="AEMZQ"
+16 ;PATCH 1
SET DIC("S")="I '$O(^AQAGP(AQAOFAC,""FACRPT"",Y,""RES"",0))!$D(^AQAGP(AQAOFAC,""FACRPT"",Y,""RES"",""B"",DUZ))"
+17 SET DA(1)=AQAOFAC
DO ^DIC
IF Y<1
SET AQAOTYP=U
QUIT AQAOTYP
+18 ;report name & number
SET AQAORPT=Y
+19 ;report title
SET AQAORPTT=$PIECE(^AQAGP(AQAOFAC,"FACRPT",+AQAORPT,0),U,2)
+20 ;
+21 ; >> find contents of report selected
+22 FOR AQAOI="MSF","HW","KF","IND","DIM"
Begin DoDot:1
+23 ;for each heading, find indicators
SET AQAOX=0
+24 FOR
SET AQAOX=$ORDER(^AQAGP(AQAOFAC,"FACRPT",+AQAORPT,AQAOI,AQAOX))
IF AQAOX'=+AQAOX
QUIT
Begin DoDot:2
+25 IF '$DATA(^AQAGP(AQAOFAC,"FACRPT",+AQAORPT,AQAOI,AQAOX,0))
QUIT
SET AQAOS=+^(0)
+26 IF (AQAOI="HW")!(AQAOI="IND")
SET Y=AQAOS
DO INDCHK^AQAOPU
DO SET
QUIT
+27 ;
+28 IF AQAOI="DIM"
DO DIMCHK
QUIT
+29 ;xref in qi ind file
SET AQAOC=$SELECT(AQAOI="MSF":"AD",1:"AB")
+30 SET Y=0
FOR
SET Y=$ORDER(^AQAO(2,AQAOC,AQAOS,Y))
IF Y=""
QUIT
DO INDCHK^AQAOPU
DO SET
End DoDot:2
End DoDot:1
+31 ;
+32 ; >> display indicators included in report
+33 DO DISPLAY
+34 ;
+35 QUIT AQAOTYP
+36 ;
+37 ;
SET ; >> SUBRTN to set indicator array
+1 ;inactive ind
IF (AQAOI="MSF")!(AQAOI="KF")
IF $GET(AQAOCHK("OK"))="I"
QUIT
+2 ;PATCH 2
IF AQAOI="HW"
SET AQAOF="FACILITY WIDE INDICATORS"
+3 IF AQAOI="IND"
SET AQAOF="OTHER INDICATORS"
+4 IF AQAOI="KF"
SET AQAOF="KEY FUNCTION - "_$PIECE(^AQAO(1,AQAOS,0),U)
+5 IF AQAOI="MSF"
Begin DoDot:1
+6 SET AQAOZ=Y
SET Y=AQAOS
SET C=$PIECE(^DD(9002168.2,.13,0),U,2)
DO Y^DIQ
+7 SET AQAOF="MED STAFF FUNCTION - "_Y
SET Y=AQAOZ
End DoDot:1
+8 ;ENH1
IF AQAOI="DIM"
SET AQAOF="DIMENSION - "_$PIECE($TEXT(DIM+AQAOS),";;",2)
+9 IF $DATA(AQAOCHK("OK"))
SET ^TMP(AQAOSUB,$JOB,1,AQAOF,Y)=""
+10 IF '$TEST
SET ^TMP(AQAOSUB,$JOB,2,$PIECE(^AQAO(2,Y,0),U))=""
+11 QUIT
+12 ;
+13 ;
DISPLAY ; >> SUBRTN to display indicators found for report
+1 SET X="Facility Specific Report: "_$PIECE(AQAORPT,U,2)
WRITE @IOF,!!,X
+2 WRITE !!,"Indicators To Be Included In This Report:"
+3 IF '$DATA(^TMP(AQAOSUB,$JOB,1))
WRITE !!,"NONE FOUND"
SET AQAOTYP=U
GOTO DSPLY9
+4 SET X=0
FOR
SET X=$ORDER(^TMP(AQAOSUB,$JOB,1,X))
IF X=""
QUIT
IF $GET(AQAOSTOP)=U
QUIT
Begin DoDot:1
+5 WRITE !!,"HEADING: ",X
+6 SET Y=0
FOR
SET Y=$ORDER(^TMP(AQAOSUB,$JOB,1,X,Y))
IF Y=""
QUIT
IF $GET(AQAOSTOP)=U
QUIT
Begin DoDot:2
+7 WRITE !?9,$PIECE(^AQAO(2,Y,0),U),?20,$PIECE(^(0),U,2)
+8 IF $Y>(IOSL-4)
SET AQAOSTOP=$$EOP^AQAOPU
IF AQAOSTOP=U
QUIT
End DoDot:2
End DoDot:1
+9 IF $DATA(^TMP(AQAOSUB,$JOB,2))
Begin DoDot:1
+10 WRITE !!,"Indicators NOT To Be Included: (You do not have access to them)"
+11 SET X=0
FOR
SET X=$ORDER(^TMP(AQAOSUB,$JOB,2,X))
IF X=""
QUIT
Begin DoDot:2
+12 WRITE !?5,X
+13 IF $Y>(IOSL-4)
SET AQAOSTOP=$$EOP^AQAOPU
IF AQAOSTOP=U
QUIT
End DoDot:2
End DoDot:1
DSPLY9 WRITE !!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
+1 QUIT
+2 ;
+3 ;
DIMCHK ; -- SUBRTN to find indicators tied to dimension
+1 NEW Y,X
SET Y=0
+2 FOR
SET Y=$ORDER(^AQAO(2,"ADIM",AQAOS,Y))
IF Y=""
QUIT
DO INDCHK^AQAOPU
DO SET
+3 SET X=0
+4 FOR
SET X=$ORDER(^AQAO1(6,"ADIM",AQAOS,X))
IF X=""
QUIT
Begin DoDot:1
+5 SET Y=0
+6 FOR
SET Y=$ORDER(^AQAO1(6,X,"IND","B",Y))
IF Y=""
QUIT
DO INDCHK^AQAOPU
DO SET
End DoDot:1
+7 QUIT
+8 ;
+9 ;
DIM ;;
+1 ;;EFFICACY
+2 ;;APPROPRIATENESS
+3 ;;AVAILABILITY
+4 ;;TIMELINESS
+5 ;;EFFECTIVENESS
+6 ;;CONTINUITY
+7 ;;SAFETY
+8 ;;EFFICIENCY
+9 ;;RESPECT & CARING
