AQAOREV1 ; IHS/ORDC/LJF - ENTER OCCURRENCE REVIEWS ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn contains entry points called by ^AQAOREV. These entry
;points print occ summary, finds and displays all previous reviews.
;
SUM ;ENTRY POINT >> SUBRTN to print occ summary
N AQAOIFN,AQAORVW,AQAOARR,AQAOCID,AQAOPAT,AQAOIND,AQAODATE
S AQAOIFN=X
S X=$P(^AQAOC(AQAOIFN,0),U,2),AQAOARR(AQAOIFN)=$P(^DPT(X,0),U)
S AQAODEV="HOME" D PRINT^AQAOPR3
Q
;
FIND ;ENTRY POINT >> SUBRTN to find all reviews
S (AQAODT,AQAOX,AQAONUM)=0,AQAOSTOP="" K AQAO
F S AQAODT=$O(^AQAOC(AQAOIFN,"REV","AC",AQAODT)) Q:AQAODT="" D
.S AQAOX=0
.F S AQAOX=$O(^AQAOC(AQAOIFN,"REV","AC",AQAODT,AQAOX)) Q:AQAOX="" D
..Q:'$D(^AQAOC(AQAOIFN,"REV",AQAOX,0)) S AQAOSTR=^(0)
..S AQAOSTG=$P(AQAOSTR,U),AQAOFIN=$P(AQAOSTR,U,5),AQAOCT=$P(AQAOSTR,U,7)
..S AQAORISK=$P(AQAOSTR,U,11),AQAOUT=$P(AQAOSTR,U,6),AQAORVR=$P(AQAOSTR,U,2)
..S AQAOSTG=$P($G(^AQAO(7,+AQAOSTG,0)),U,2) ;review stage
..S:AQAORVR'="" AQAORVR=U_$P(AQAORVR,";",2)_+AQAORVR_",0)",AQAORVR=$P(@AQAORVR,U,2) ;reviewer
..S AQAOFIN=$P($G(^AQAO(8,+AQAOFIN,0)),U,2) ;finding
..S AQAOCT=$P($G(^AQAO(6,+AQAOCT,0)),U,2) ;action
..S AQAORISK=$P($G(^AQAO1(3,+AQAORISK,0)),U) ;risk
..S AQAOUT=$P($G(^AQAO1(3,+AQAOUT,0)),U) ;outcome
..S X=" ",Y=AQAODT X ^DD("DD") S AQAONUM=AQAONUM+1
..S AQAO(AQAONUM)=AQAOX_U_Y_U_AQAOSTG_U_AQAOFIN_U_AQAOCT_U_AQAORISK_U_AQAOUT_U_AQAORVR
.Q
S AQAOSTR=$G(^AQAOC(AQAOIFN,1))
I $P(AQAOSTR,U,3)="" D S AQAOSTOP=U Q
.W !!!!,"INITIAL REVIEW not yet entered." D PRTOPT^AQAOVAR
;
DISPLAY ; display reviews found
W !!?20,"**** REVIEWS FOUND FOR CASE #",AQAOCID," ****",!
W ?20,"(Initial Review [I] cannot be edited here)",!
W !?4,"Review Date",?19,"Stage",?26,"Reviewed by",?39,"Occ Risk"
W ?49,"Occ Outcome",?62,"Finding",?72,"Action",!
; print initial review data
S Y=$P(AQAOSTR,U,8) X ^DD("DD") W !,"I.",?4,Y ;review date
S X=$P(AQAOSTR,U,3) W:X'="" ?21,$P($G(^AQAO(7,X,0)),U,2) ;stage
S X=$P(AQAOSTR,U,4) I X]"" S X=U_$P(X,";",2)_+X_",0)" W ?29,$P(@X,U,2) ;reviewr
S X=$P(AQAOSTR,U,11) W:X'="" ?43,$P($G(^AQAO1(3,X,0)),U) ;risk
S X=$P(AQAOSTR,U,7) W:X'="" ?53,$P($G(^AQAO1(3,X,0)),U) ;outcome
S X=$P(AQAOSTR,U,5) W:X'="" ?64,$P($G(^AQAO(8,X,0)),U,2) ;finding
S X=$P(AQAOSTR,U,6) W:X'="" ?73,$P($G(^AQAO(6,X,0)),U,2) ;action
;
;print all other reviews by date
S AQAON=0 F S AQAON=$O(AQAO(AQAON)) Q:AQAON="" D
.W !,AQAON_".",?4,$P(AQAO(AQAON),U,2),?21,$P(AQAO(AQAON),U,3)
.W ?29,$P(AQAO(AQAON),U,8),?43,$P(AQAO(AQAON),U,6),?53,$P(AQAO(AQAON),U,7)
.W ?64,$P(AQAO(AQAON),U,4),?73,$P(AQAO(AQAON),U,5)
Q
AQAOREV1 ; IHS/ORDC/LJF - ENTER OCCURRENCE REVIEWS ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn contains entry points called by ^AQAOREV. These entry
+4 ;points print occ summary, finds and displays all previous reviews.
+5 ;
SUM ;ENTRY POINT >> SUBRTN to print occ summary
+1 NEW AQAOIFN,AQAORVW,AQAOARR,AQAOCID,AQAOPAT,AQAOIND,AQAODATE
+2 SET AQAOIFN=X
+3 SET X=$PIECE(^AQAOC(AQAOIFN,0),U,2)
SET AQAOARR(AQAOIFN)=$PIECE(^DPT(X,0),U)
+4 SET AQAODEV="HOME"
DO PRINT^AQAOPR3
+5 QUIT
+6 ;
FIND ;ENTRY POINT >> SUBRTN to find all reviews
+1 SET (AQAODT,AQAOX,AQAONUM)=0
SET AQAOSTOP=""
KILL AQAO
+2 FOR
SET AQAODT=$ORDER(^AQAOC(AQAOIFN,"REV","AC",AQAODT))
IF AQAODT=""
QUIT
Begin DoDot:1
+3 SET AQAOX=0
+4 FOR
SET AQAOX=$ORDER(^AQAOC(AQAOIFN,"REV","AC",AQAODT,AQAOX))
IF AQAOX=""
QUIT
Begin DoDot:2
+5 IF '$DATA(^AQAOC(AQAOIFN,"REV",AQAOX,0))
QUIT
SET AQAOSTR=^(0)
+6 SET AQAOSTG=$PIECE(AQAOSTR,U)
SET AQAOFIN=$PIECE(AQAOSTR,U,5)
SET AQAOCT=$PIECE(AQAOSTR,U,7)
+7 SET AQAORISK=$PIECE(AQAOSTR,U,11)
SET AQAOUT=$PIECE(AQAOSTR,U,6)
SET AQAORVR=$PIECE(AQAOSTR,U,2)
+8 ;review stage
SET AQAOSTG=$PIECE($GET(^AQAO(7,+AQAOSTG,0)),U,2)
+9 ;reviewer
IF AQAORVR'=""
SET AQAORVR=U_$PIECE(AQAORVR,";",2)_+AQAORVR_",0)"
SET AQAORVR=$PIECE(@AQAORVR,U,2)
+10 ;finding
SET AQAOFIN=$PIECE($GET(^AQAO(8,+AQAOFIN,0)),U,2)
+11 ;action
SET AQAOCT=$PIECE($GET(^AQAO(6,+AQAOCT,0)),U,2)
+12 ;risk
SET AQAORISK=$PIECE($GET(^AQAO1(3,+AQAORISK,0)),U)
+13 ;outcome
SET AQAOUT=$PIECE($GET(^AQAO1(3,+AQAOUT,0)),U)
+14 SET X=" "
SET Y=AQAODT
XECUTE ^DD("DD")
SET AQAONUM=AQAONUM+1
+15 SET AQAO(AQAONUM)=AQAOX_U_Y_U_AQAOSTG_U_AQAOFIN_U_AQAOCT_U_AQAORISK_U_AQAOUT_U_AQAORVR
End DoDot:2
+16 QUIT
End DoDot:1
+17 SET AQAOSTR=$GET(^AQAOC(AQAOIFN,1))
+18 IF $PIECE(AQAOSTR,U,3)=""
Begin DoDot:1
+19 WRITE !!!!,"INITIAL REVIEW not yet entered."
DO PRTOPT^AQAOVAR
End DoDot:1
SET AQAOSTOP=U
QUIT
+20 ;
DISPLAY ; display reviews found
+1 WRITE !!?20,"**** REVIEWS FOUND FOR CASE #",AQAOCID," ****",!
+2 WRITE ?20,"(Initial Review [I] cannot be edited here)",!
+3 WRITE !?4,"Review Date",?19,"Stage",?26,"Reviewed by",?39,"Occ Risk"
+4 WRITE ?49,"Occ Outcome",?62,"Finding",?72,"Action",!
+5 ; print initial review data
+6 ;review date
SET Y=$PIECE(AQAOSTR,U,8)
XECUTE ^DD("DD")
WRITE !,"I.",?4,Y
+7 ;stage
SET X=$PIECE(AQAOSTR,U,3)
IF X'=""
WRITE ?21,$PIECE($GET(^AQAO(7,X,0)),U,2)
+8 ;reviewr
SET X=$PIECE(AQAOSTR,U,4)
IF X]""
SET X=U_$PIECE(X,";",2)_+X_",0)"
WRITE ?29,$PIECE(@X,U,2)
+9 ;risk
SET X=$PIECE(AQAOSTR,U,11)
IF X'=""
WRITE ?43,$PIECE($GET(^AQAO1(3,X,0)),U)
+10 ;outcome
SET X=$PIECE(AQAOSTR,U,7)
IF X'=""
WRITE ?53,$PIECE($GET(^AQAO1(3,X,0)),U)
+11 ;finding
SET X=$PIECE(AQAOSTR,U,5)
IF X'=""
WRITE ?64,$PIECE($GET(^AQAO(8,X,0)),U,2)
+12 ;action
SET X=$PIECE(AQAOSTR,U,6)
IF X'=""
WRITE ?73,$PIECE($GET(^AQAO(6,X,0)),U,2)
+13 ;
+14 ;print all other reviews by date
+15 SET AQAON=0
FOR
SET AQAON=$ORDER(AQAO(AQAON))
IF AQAON=""
QUIT
Begin DoDot:1
+16 WRITE !,AQAON_".",?4,$PIECE(AQAO(AQAON),U,2),?21,$PIECE(AQAO(AQAON),U,3)
+17 WRITE ?29,$PIECE(AQAO(AQAON),U,8),?43,$PIECE(AQAO(AQAON),U,6),?53,$PIECE(AQAO(AQAON),U,7)
+18 WRITE ?64,$PIECE(AQAO(AQAON),U,4),?73,$PIECE(AQAO(AQAON),U,5)
End DoDot:1
+19 QUIT
