- AQAOPR71 ; IHS/ORDC/LJF - CALCULATE REVIEWED OCC RPRT ;
- ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- ;
- ;This rtn finds all appropriate occurrences based on indicators
- ;selected and date range.
- ;
- K ^TMP("AQAOPR7A",$J)
- S AQAOCNT=0 ;initialize total count
- TMP ; >>> loop thru ^TMP to find indicators
- F AQAOI="SINGLE","MED STAFF F","FACILITY WIDE","KEY FUNCTION","DIMENSION","OTHER" D
- .S AQAOF=AQAOI
- .F S AQAOF=$O(^TMP("AQAOPR7",$J,1,AQAOF)) Q:AQAOF'[AQAOI D
- ..S AQAOIND=0
- ..F S AQAOIND=$O(^TMP("AQAOPR7",$J,1,AQAOF,AQAOIND)) Q:AQAOIND="" D
- ...;
- ...; >>for this indicator, find occ for date range
- ...S AQAODT=AQAOBD-.0001,AQAOEDT=AQAOED_.2400
- ...F S AQAODT=$O(^AQAOC("AA",AQAOIND,AQAODT)) Q:AQAODT="" Q:AQAODT>AQAOEDT D
- ....S DFN=0
- ....F S DFN=$O(^AQAOC("AA",AQAOIND,AQAODT,DFN)) Q:DFN="" D
- .....S AQAOIFN=0
- .....F S AQAOIFN=$O(^AQAOC("AA",AQAOIND,AQAODT,DFN,AQAOIFN)) Q:AQAOIFN="" D
- ......Q:'$$STATUS ;wrong case status
- ......Q:'$$USERTEAM ;at least one rev/ref has one of selected user/team
- ......S AQAOCNT=AQAOCNT+1 ;increment total cases
- ......S X=$P(^AQAO(2,AQAOIND,0),U)_" "_$P(^(0),U,2) ;ind # & name
- ......S ^TMP("AQAOPR7A",$J,X,AQAODT,AQAOIFN)=""
- ;
- NEXT ; >>> go to print rtn
- G ^AQAOPR72
- ;
- ;
- STATUS() ;EXTR VAR to check case status against user's choice
- N X,Y S X=1,Y=$P(^AQAOC(AQAOIFN,1),U) ;status (open,closed,deleted)
- I (AQAOSTAT'[1),(Y=0) S X=0 ;open not included in user's choice
- I (AQAOSTAT'[2),(Y=1) S X=0 ;closed not included in user's choice
- I (AQAOSTAT'[3),(Y=2) S X=0 ;deleted not included in user's choice
- Q X
- ;
- ;
- USERTEAM() ;EXTR VAR to check selected user/teams against occ review
- N W,X,Y,Z
- S Z=$P($G(^AQAOC(AQAOIFN,1)),U,4) I Z="" Q 0 ;initial reviewer
- I ('$O(AQAOO("USR",0))),('$O(AQAOO("TEAM",0))) Q 1 ;no restrictions
- I $$OK Q 1
- S Z=$P($G(^AQAOC(AQAOIFN,1)),U,9) I Z="" Q 0 ;initial referral
- I $$OK Q 1
- S (Y,X)=0 F S X=$O(^AQAOC(AQAOIFN,"IADDRV",X)) Q:'X Q:Y=1 D
- .S Z=$P($G(^AQAOC(AQAOIFN,"IADDRV",X,0)),U) I Z="" Q
- .I $$OK S Y=1 Q
- I Y=1 Q 1 ;at least one add referrals
- S (Y,X)=0 F S X=$O(^AQAOC(AQAOIFN,"REV",X)) Q:'X Q:Y=1 D
- .S Z=$P($G(^AQAOC(AQAOIFN,"REV",X,0)),U,2) I Z="" Q
- .I $$OK S Y=1 Q
- .S W=0 F S W=$O(^AQAOC(AQAOIFN,"REV",X,"ADDRV",W)) Q:'W Q:Y=1 D
- ..S Z=$P($G(^AQAOC(AQAOIFN,"REV",X,"ADDRV",W,0)),U) I Z="" Q
- ..I $$OK S Y=1 Q
- Q Y
- ;
- ;
- OK() ;EXTR VAR to test entry against selection arrays
- Q ($D(AQAOO("USR",Z)))!($D(AQAOO("TEAM",Z)))
- AQAOPR71 ; IHS/ORDC/LJF - CALCULATE REVIEWED OCC RPRT ;
- +1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- +2 ;
- +3 ;This rtn finds all appropriate occurrences based on indicators
- +4 ;selected and date range.
- +5 ;
- +6 KILL ^TMP("AQAOPR7A",$JOB)
- +7 ;initialize total count
- SET AQAOCNT=0
- TMP ; >>> loop thru ^TMP to find indicators
- +1 FOR AQAOI="SINGLE","MED STAFF F","FACILITY WIDE","KEY FUNCTION","DIMENSION","OTHER"
- Begin DoDot:1
- +2 SET AQAOF=AQAOI
- +3 FOR
- SET AQAOF=$ORDER(^TMP("AQAOPR7",$JOB,1,AQAOF))
- IF AQAOF'[AQAOI
- QUIT
- Begin DoDot:2
- +4 SET AQAOIND=0
- +5 FOR
- SET AQAOIND=$ORDER(^TMP("AQAOPR7",$JOB,1,AQAOF,AQAOIND))
- IF AQAOIND=""
- QUIT
- Begin DoDot:3
- +6 ;
- +7 ; >>for this indicator, find occ for date range
- +8 SET AQAODT=AQAOBD-.0001
- SET AQAOEDT=AQAOED_.2400
- +9 FOR
- SET AQAODT=$ORDER(^AQAOC("AA",AQAOIND,AQAODT))
- IF AQAODT=""
- QUIT
- IF AQAODT>AQAOEDT
- QUIT
- Begin DoDot:4
- +10 SET DFN=0
- +11 FOR
- SET DFN=$ORDER(^AQAOC("AA",AQAOIND,AQAODT,DFN))
- IF DFN=""
- QUIT
- Begin DoDot:5
- +12 SET AQAOIFN=0
- +13 FOR
- SET AQAOIFN=$ORDER(^AQAOC("AA",AQAOIND,AQAODT,DFN,AQAOIFN))
- IF AQAOIFN=""
- QUIT
- Begin DoDot:6
- +14 ;wrong case status
- IF '$$STATUS
- QUIT
- +15 ;at least one rev/ref has one of selected user/team
- IF '$$USERTEAM
- QUIT
- +16 ;increment total cases
- SET AQAOCNT=AQAOCNT+1
- +17 ;ind # & name
- SET X=$PIECE(^AQAO(2,AQAOIND,0),U)_" "_$PIECE(^(0),U,2)
- +18 SET ^TMP("AQAOPR7A",$JOB,X,AQAODT,AQAOIFN)=""
- End DoDot:6
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +19 ;
- NEXT ; >>> go to print rtn
- +1 GOTO ^AQAOPR72
- +2 ;
- +3 ;
- STATUS() ;EXTR VAR to check case status against user's choice
- +1 ;status (open,closed,deleted)
- NEW X,Y
- SET X=1
- SET Y=$PIECE(^AQAOC(AQAOIFN,1),U)
- +2 ;open not included in user's choice
- IF (AQAOSTAT'[1)
- IF (Y=0)
- SET X=0
- +3 ;closed not included in user's choice
- IF (AQAOSTAT'[2)
- IF (Y=1)
- SET X=0
- +4 ;deleted not included in user's choice
- IF (AQAOSTAT'[3)
- IF (Y=2)
- SET X=0
- +5 QUIT X
- +6 ;
- +7 ;
- USERTEAM() ;EXTR VAR to check selected user/teams against occ review
- +1 NEW W,X,Y,Z
- +2 ;initial reviewer
- SET Z=$PIECE($GET(^AQAOC(AQAOIFN,1)),U,4)
- IF Z=""
- QUIT 0
- +3 ;no restrictions
- IF ('$ORDER(AQAOO("USR",0)))
- IF ('$ORDER(AQAOO("TEAM",0)))
- QUIT 1
- +4 IF $$OK
- QUIT 1
- +5 ;initial referral
- SET Z=$PIECE($GET(^AQAOC(AQAOIFN,1)),U,9)
- IF Z=""
- QUIT 0
- +6 IF $$OK
- QUIT 1
- +7 SET (Y,X)=0
- FOR
- SET X=$ORDER(^AQAOC(AQAOIFN,"IADDRV",X))
- IF 'X
- QUIT
- IF Y=1
- QUIT
- Begin DoDot:1
- +8 SET Z=$PIECE($GET(^AQAOC(AQAOIFN,"IADDRV",X,0)),U)
- IF Z=""
- QUIT
- +9 IF $$OK
- SET Y=1
- QUIT
- End DoDot:1
- +10 ;at least one add referrals
- IF Y=1
- QUIT 1
- +11 SET (Y,X)=0
- FOR
- SET X=$ORDER(^AQAOC(AQAOIFN,"REV",X))
- IF 'X
- QUIT
- IF Y=1
- QUIT
- Begin DoDot:1
- +12 SET Z=$PIECE($GET(^AQAOC(AQAOIFN,"REV",X,0)),U,2)
- IF Z=""
- QUIT
- +13 IF $$OK
- SET Y=1
- QUIT
- +14 SET W=0
- FOR
- SET W=$ORDER(^AQAOC(AQAOIFN,"REV",X,"ADDRV",W))
- IF 'W
- QUIT
- IF Y=1
- QUIT
- Begin DoDot:2
- +15 SET Z=$PIECE($GET(^AQAOC(AQAOIFN,"REV",X,"ADDRV",W,0)),U)
- IF Z=""
- QUIT
- +16 IF $$OK
- SET Y=1
- QUIT
- End DoDot:2
- End DoDot:1
- +17 QUIT Y
- +18 ;
- +19 ;
- OK() ;EXTR VAR to test entry against selection arrays
- +1 QUIT ($DATA(AQAOO("USR",Z)))!($DATA(AQAOO("TEAM",Z)))
