WVRPPCD2 ;HCIOFO/FT,JR-REPORT: PROCEDURES STATISTICS; ;7/24/01 14:11
;;1.0;WOMEN'S HEALTH;**12**;Sep 30, 1998
;; Original routine created by IHS/ANMC/MWR
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; COLLATING CODE CALLED BY WVRPPCD.
;
; This routine uses the following IAs:
; <NONE>
;
SORT ;EP
;---> SORT AND STORE LOCAL ARRAY IN ^TMP("WV",$J,1,
K ^TMP("WV",$J),WVRES,^TMP("WVX",$J),^TMP("WVNOHCF",$J)
I $D(ZTQUEUED) S ZTREQ="@"
;---> WVBEGDT1=ONE SECOND BEFORE BEGIN DATE.
;---> WVENDDT1=THE LAST SECOND OF END DATE.
N FE,FI,I,WVDFN,WVHCFN,WVHIEN,WVIEN,WVPCD,WVZSTOP,Y
S WVBEGDT1=WVBEGDT-.0001,WVENDDT1=WVENDDT+.9999
S WVDATE=WVBEGDT1,WVZSTOP=0
F S WVDATE=$O(^WV(790.1,"D",WVDATE)) Q:'WVDATE!(WVDATE>WVENDDT1)!($G(ZTSTOP)=1) D
.S WVIEN=0
.F S WVIEN=$O(^WV(790.1,"D",WVDATE,WVIEN)) Q:'WVIEN!($G(ZTSTOP)=1) D
..S WVZSTOP=WVZSTOP+1
..;If background task, then every 100 records check if user wants to
..;stop the task.
..I $D(ZTQUEUED),WVZSTOP#100=0 D STOPCHK^WVUTL10(0) Q:$G(ZTSTOP)=1
..S Y=^WV(790.1,WVIEN,0)
..;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".
..Q:$P(Y,U,5)=8
..S WVDFN=$P(Y,U,2),WVPCD=$P(Y,U,4),WVHCF=$P(Y,U,10) ;patient ien, procedure ien, facility ien
..I 'WVHCF S ^TMP("WVNOHCF",$J,WVIEN)="" Q ;no facility
..S WVHCFN=$$FACNAME(WVHCF)
..I WVHCFN="" S ^TMP("WVNOHCF",$J,WVIEN)="" Q ;no facility name
..S WVAGE=$$WVAGE(WVDFN,$P(Y,U,12),WVAGRG)
..;---> QUIT IF PATIENT'S AGE IS UNKNOWN OR OUTSIDE OF AGE RANGE.
..Q:'WVAGE
..;---> QUIT IF NOT SELECTING FOR ALL PROCEDURES AND IF THIS IS
..;---> NOT ONE OF THE SELECTED PROCEDURES.
..I '$D(WVARR("ALL")) Q:'$D(WVARR(WVPCD))
..;---> Quit if Facility is not one selected by user
..I '$D(WVSB("ALL")) Q:'$D(WVSB(WVHCF))
..;---> FOR WVRES: 0=NORMAL, 1=ABNORMAL, 2=NO RESULT.
..S WVRES=$$NORMAL^WVUTL4($P(Y,U,5))
..; Below 5 Lines added to gather Rad Credit for rept
..S WVJRC=$P($G(^WV(790.1,WVIEN,0)),U,35) I WVJRC'="" D
...I '$D(^TMP("WVX",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES,WVJRC)) D Q
....S ^TMP("WVX",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES,WVJRC)=1
...S X=^TMP("WVX",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES,WVJRC)+1
...S ^TMP("WVX",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES,WVJRC)=X
..I '$D(^TMP("WV",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES)) D Q
...S ^TMP("WV",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES)=1
..S X=^TMP("WV",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES)+1
..S ^TMP("WV",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES)=X
..Q
.Q
Q:$G(ZTSTOP)=1 ;user stopped the background task
;
TOTALS ;EP
;---> N=WVPCD, Q=WVAGE, M=WVDFN, P=WVRES (0,1,2), FI=WVHCF(internal)
;---> FE=WVHCF(external)
N I,M,N,P,Q
S FE=""
F S FE=$O(^TMP("WV",$J,FE)) Q:FE="" S FI=0 F S FI=$O(^TMP("WV",$J,FE,FI)) Q:'FI S N=0 F S N=$O(^TMP("WV",$J,FE,FI,N)) Q:N="" D
.S Q=0
.F S Q=$O(^TMP("WV",$J,FE,FI,N,Q)) Q:Q="" D
..F I=0,1,2 S ^TMP("WVRES",$J,FE,FI,N,Q,I,"P")=0 S ^TMP("WVRES",$J,FE,FI,N,Q,I,"T")=0
..S M=0,(^TMP("WVRES",$J,FE,FI,N,Q,"P"),^TMP("WVRES",$J,FE,FI,N,Q,"T"),^TMP("WVRES",$J,FE,FI,N,Q,"VT","P"),^TMP("WVRES",$J,FE,FI,N,Q,"VT","T"))=0
..F S M=$O(^TMP("WV",$J,FE,FI,N,Q,M)) Q:M="" D
...S P=-1,^TMP("WVRES",$J,FE,FI,N,Q,"P")=^TMP("WVRES",$J,FE,FI,N,Q,"P")+1
...I $$GET1^DIQ(2,M,1901,"I")="Y" S ^TMP("WVRES",$J,FE,FI,N,Q,"VT","PA")=$G(^TMP("WVRES",$J,FE,FI,N,Q,"VT","PA"))+1
...F S P=$O(^TMP("WV",$J,FE,FI,N,Q,M,P)) Q:P="" D
....S ^TMP("WVRES",$J,FE,FI,N,Q,P,"P")=^TMP("WVRES",$J,FE,FI,N,Q,P,"P")+1
....S ^TMP("WVRES",$J,FE,FI,N,Q,P,"T")=^TMP("WVRES",$J,FE,FI,N,Q,P,"T")+^TMP("WV",$J,FE,FI,N,Q,M,P)
....I $$GET1^DIQ(2,M,1901,"I")="Y" D
.....S ^TMP("WVRES",$J,FE,FI,N,Q,P,"VT","P")=$G(^TMP("WVRES",$J,FE,FI,N,Q,P,"VT","P"))+1
.....S ^TMP("WVRES",$J,FE,FI,N,Q,P,"VT","T")=$G(^TMP("WVRES",$J,FE,FI,N,Q,P,"VT","T"))+^TMP("WV",$J,FE,FI,N,Q,M,P)
....F WVJRC=0,2 D
.....I $G(^TMP("WVX",$J,FE,FI,N,Q,M,P,WVJRC))'="" S ^TMP("WVRES",$J,FE,FI,N,Q,"CM","PA",WVJRC)=$G(^TMP("WVRES",$J,FE,FI,N,Q,"CM","PA",WVJRC))+1 D
......S ^TMP("WVRES",$J,FE,FI,N,Q,P,"CM","P",WVJRC)=$G(^TMP("WVRES",$J,FE,FI,N,Q,P,"CM","P",WVJRC))+1
......S ^TMP("WVRES",$J,FE,FI,N,Q,P,"CM","T",WVJRC)=$G(^TMP("WVRES",$J,FE,FI,N,Q,P,"CM","T",WVJRC))+^TMP("WVX",$J,FE,FI,N,Q,M,P,WVJRC)
;---> NOW COMPUTE TOTAL #PROCEDURES FOR EACH PROCEDURE, EACH AGE GROUP.
S FE=""
F S FE=$O(^TMP("WVRES",$J,FE)) Q:FE="" S FI=0 F S FI=$O(^TMP("WVRES",$J,FE,FI)) Q:'FI S N=0 F S N=$O(^TMP("WVRES",$J,FE,FI,N)) Q:'N D
.S Q=0 F S Q=$O(^TMP("WVRES",$J,FE,FI,N,Q)) Q:'Q D
..S M=-1 F S M=$O(^TMP("WVRES",$J,FE,FI,N,Q,M)) Q:M=""!(M'?1N.N) D
...S ^TMP("WVRES",$J,FE,FI,N,Q,"T")=^TMP("WVRES",$J,FE,FI,N,Q,"T")+^TMP("WVRES",$J,FE,FI,N,Q,M,"T")
...;S ^TMP("WVRES",$J,FE,FI,N,Q,"P")=^TMP("WVRES",$J,FE,FI,N,Q,"P")+^TMP("WVRES",$J,FE,FI,N,Q,M,"P")
...S ^TMP("WVRES",$J,FE,FI,N,Q,"VT","T")=$G(^TMP("WVRES",$J,FE,FI,N,Q,"VT","T"))+$G(^TMP("WVRES",$J,FE,FI,N,Q,M,"VT","T"))
...S ^TMP("WVRES",$J,FE,FI,N,Q,"VT","P")=$G(^TMP("WVRES",$J,FE,FI,N,Q,"VT","P"))+$G(^TMP("WVRES",$J,FE,FI,N,Q,M,"VT","P"))
...;*******************************************
...F WVJRC=0,2 D
....S ^TMP("WVRES",$J,FE,FI,N,Q,"CM","T",WVJRC)=$G(^TMP("WVRES",$J,FE,FI,N,Q,"CM","T",WVJRC))+$G(^TMP("WVRES",$J,FE,FI,N,Q,M,"CM","T",WVJRC))
....S ^TMP("WVRES",$J,FE,FI,N,Q,"CM","P",WVJRC)=$G(^TMP("WVRES",$J,FE,FI,N,Q,"CM","P",WVJRC))+$G(^TMP("WVRES",$J,FE,FI,N,Q,M,"CM","P",WVJRC))
...;*******************************************
;
;
;-> NOW COMPUTE TOTAL #PROCEDURES FOR EACH PROCEDURE.
;-> ^TMP("WVRES",$J,FE,FI,N,"P")=TOTAL PATIENTS WHO RECEIVED THIS PROCEDURE
;-> ^TMP("WVRES",$J,FE,FI,N,"T")=TOTAL TIMES THIS PROCEDURE WAS PERFORMED
S FE=""
F S FE=$O(^TMP("WVRES",$J,FE)) Q:FE="" S FI=0 F S FI=$O(^TMP("WVRES",$J,FE,FI)) Q:'FI S N=0 F S N=$O(^TMP("WVRES",$J,FE,FI,N)) Q:'N D
.S Q=0,^TMP("WVRES",$J,FE,FI,N,"P")=0,^TMP("WVRES",$J,FE,FI,N,"T")=0,^TMP("WVRES",$J,FE,FI,N,"VT","P")=0
.S ^TMP("WVRES",$J,FE,FI,N,"VT","T")=0,^TMP("WVRES",$J,FE,FI,N,"VT","PA")=0
.F WVJRC=0,2 S ^TMP("WVRES",$J,FE,FI,N,"CM","T",WVJRC)=0,^TMP("WVRES",$J,FE,FI,N,"CM","PA",WVJRC)=0
.F S Q=$O(^TMP("WVRES",$J,FE,FI,N,Q)) Q:'Q D
..S ^TMP("WVRES",$J,FE,FI,N,"P")=^TMP("WVRES",$J,FE,FI,N,"P")+^TMP("WVRES",$J,FE,FI,N,Q,"P")
..S ^TMP("WVRES",$J,FE,FI,N,"T")=^TMP("WVRES",$J,FE,FI,N,"T")+^TMP("WVRES",$J,FE,FI,N,Q,"T")
..S ^TMP("WVRES",$J,FE,FI,N,"VT","P")=^TMP("WVRES",$J,FE,FI,N,"VT","P")+$G(^TMP("WVRES",$J,FE,FI,N,Q,"VT","P"))
..S ^TMP("WVRES",$J,FE,FI,N,"VT","T")=^TMP("WVRES",$J,FE,FI,N,"VT","T")+$G(^TMP("WVRES",$J,FE,FI,N,Q,"VT","T"))
..S ^TMP("WVRES",$J,FE,FI,N,"VT","PA")=^TMP("WVRES",$J,FE,FI,N,"VT","PA")+$G(^TMP("WVRES",$J,FE,FI,N,Q,"VT","PA"))
..F WVJRC=0,2 D
...S ^TMP("WVRES",$J,FE,FI,N,"CM","P",WVJRC)=$G(^TMP("WVRES",$J,FE,FI,N,"CM","P",WVJRC))+$G(^TMP("WVRES",$J,FE,FI,N,Q,"CM","P",WVJRC))
...S ^TMP("WVRES",$J,FE,FI,N,"CM","T",WVJRC)=$G(^TMP("WVRES",$J,FE,FI,N,"CM","T",WVJRC))+$G(^TMP("WVRES",$J,FE,FI,N,Q,"CM","T",WVJRC))
...S ^TMP("WVRES",$J,FE,FI,N,"CM","PA",WVJRC)=$G(^TMP("WVRES",$J,FE,FI,N,"CM","PA",WVJRC))+$G(^TMP("WVRES",$J,FE,FI,N,Q,"CM","PA",WVJRC))
;
D FLATFL^WVRPPCD3
Q
;
WVAGE(DFN,DATE,X) ;EP
;---> SET AGE CATEGORY.
;---> REQUIRED VARIABLES: DATE=DATE PATIENT RECEIVED THIS PROCEDURE.
;---> DFN, X=WVAGRG (AGE RANGE).
;---> IF NOT DISPLAY BY AGE, SET ALL WVAGE=1
Q:X=1 1
N AGE,Y,Z
S AGE=$P($$AGEAT^WVUTL1(DFN,DATE),"y/o")
;---> RETURN 0 IF PATIENT'S AGE IS UNKNOWN.
Q:'+AGE 0
;
F I=1:1:$L(X,",") S Y=$P($P(X,",",I),"-",2) Q:AGE'>Y
S Z=$P($P(X,",",I),"-")
;---> RETURN 0 IF PATIENT IS OUTSIDE DATE RANGE.
Q:(AGE<Z!(AGE>Y)) 0
Q Y
FACNAME(IEN) ; Return Facility name
; Check if ien has been looked up already.
I $G(WVHIEN(IEN))]"" Q $G(WVHIEN(IEN))
N NAME
S NAME=$$INSTTX^WVUTL6(IEN) ;get facility name
I NAME="" Q ""
S WVHIEN(IEN)=NAME ;update local array with name and ien
Q NAME
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVRPPCD2 7997 printed Dec 13, 2024@02:47:53 Page 2
WVRPPCD2 ;HCIOFO/FT,JR-REPORT: PROCEDURES STATISTICS; ;7/24/01 14:11
+1 ;;1.0;WOMEN'S HEALTH;**12**;Sep 30, 1998
+2 ;; Original routine created by IHS/ANMC/MWR
+3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+4 ;; COLLATING CODE CALLED BY WVRPPCD.
+5 ;
+6 ; This routine uses the following IAs:
+7 ; <NONE>
+8 ;
SORT ;EP
+1 ;---> SORT AND STORE LOCAL ARRAY IN ^TMP("WV",$J,1,
+2 KILL ^TMP("WV",$JOB),WVRES,^TMP("WVX",$JOB),^TMP("WVNOHCF",$JOB)
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 ;---> WVBEGDT1=ONE SECOND BEFORE BEGIN DATE.
+5 ;---> WVENDDT1=THE LAST SECOND OF END DATE.
+6 NEW FE,FI,I,WVDFN,WVHCFN,WVHIEN,WVIEN,WVPCD,WVZSTOP,Y
+7 SET WVBEGDT1=WVBEGDT-.0001
SET WVENDDT1=WVENDDT+.9999
+8 SET WVDATE=WVBEGDT1
SET WVZSTOP=0
+9 FOR
SET WVDATE=$ORDER(^WV(790.1,"D",WVDATE))
if 'WVDATE!(WVDATE>WVENDDT1)!($GET(ZTSTOP)=1)
QUIT
Begin DoDot:1
+10 SET WVIEN=0
+11 FOR
SET WVIEN=$ORDER(^WV(790.1,"D",WVDATE,WVIEN))
if 'WVIEN!($GET(ZTSTOP)=1)
QUIT
Begin DoDot:2
+12 SET WVZSTOP=WVZSTOP+1
+13 ;If background task, then every 100 records check if user wants to
+14 ;stop the task.
+15 IF $DATA(ZTQUEUED)
IF WVZSTOP#100=0
DO STOPCHK^WVUTL10(0)
if $GET(ZTSTOP)=1
QUIT
+16 SET Y=^WV(790.1,WVIEN,0)
+17 ;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".
+18 if $PIECE(Y,U,5)=8
QUIT
+19 ;patient ien, procedure ien, facility ien
SET WVDFN=$PIECE(Y,U,2)
SET WVPCD=$PIECE(Y,U,4)
SET WVHCF=$PIECE(Y,U,10)
+20 ;no facility
IF 'WVHCF
SET ^TMP("WVNOHCF",$JOB,WVIEN)=""
QUIT
+21 SET WVHCFN=$$FACNAME(WVHCF)
+22 ;no facility name
IF WVHCFN=""
SET ^TMP("WVNOHCF",$JOB,WVIEN)=""
QUIT
+23 SET WVAGE=$$WVAGE(WVDFN,$PIECE(Y,U,12),WVAGRG)
+24 ;---> QUIT IF PATIENT'S AGE IS UNKNOWN OR OUTSIDE OF AGE RANGE.
+25 if 'WVAGE
QUIT
+26 ;---> QUIT IF NOT SELECTING FOR ALL PROCEDURES AND IF THIS IS
+27 ;---> NOT ONE OF THE SELECTED PROCEDURES.
+28 IF '$DATA(WVARR("ALL"))
if '$DATA(WVARR(WVPCD))
QUIT
+29 ;---> Quit if Facility is not one selected by user
+30 IF '$DATA(WVSB("ALL"))
if '$DATA(WVSB(WVHCF))
QUIT
+31 ;---> FOR WVRES: 0=NORMAL, 1=ABNORMAL, 2=NO RESULT.
+32 SET WVRES=$$NORMAL^WVUTL4($PIECE(Y,U,5))
+33 ; Below 5 Lines added to gather Rad Credit for rept
+34 SET WVJRC=$PIECE($GET(^WV(790.1,WVIEN,0)),U,35)
IF WVJRC'=""
Begin DoDot:3
+35 IF '$DATA(^TMP("WVX",$JOB,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES,WVJRC))
Begin DoDot:4
+36 SET ^TMP("WVX",$JOB,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES,WVJRC)=1
End DoDot:4
QUIT
+37 SET X=^TMP("WVX",$JOB,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES,WVJRC)+1
+38 SET ^TMP("WVX",$JOB,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES,WVJRC)=X
End DoDot:3
+39 IF '$DATA(^TMP("WV",$JOB,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES))
Begin DoDot:3
+40 SET ^TMP("WV",$JOB,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES)=1
End DoDot:3
QUIT
+41 SET X=^TMP("WV",$JOB,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES)+1
+42 SET ^TMP("WV",$JOB,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES)=X
+43 QUIT
End DoDot:2
+44 QUIT
End DoDot:1
+45 ;user stopped the background task
if $GET(ZTSTOP)=1
QUIT
+46 ;
TOTALS ;EP
+1 ;---> N=WVPCD, Q=WVAGE, M=WVDFN, P=WVRES (0,1,2), FI=WVHCF(internal)
+2 ;---> FE=WVHCF(external)
+3 NEW I,M,N,P,Q
+4 SET FE=""
+5 FOR
SET FE=$ORDER(^TMP("WV",$JOB,FE))
if FE=""
QUIT
SET FI=0
FOR
SET FI=$ORDER(^TMP("WV",$JOB,FE,FI))
if 'FI
QUIT
SET N=0
FOR
SET N=$ORDER(^TMP("WV",$JOB,FE,FI,N))
if N=""
QUIT
Begin DoDot:1
+6 SET Q=0
+7 FOR
SET Q=$ORDER(^TMP("WV",$JOB,FE,FI,N,Q))
if Q=""
QUIT
Begin DoDot:2
+8 FOR I=0,1,2
SET ^TMP("WVRES",$JOB,FE,FI,N,Q,I,"P")=0
SET ^TMP("WVRES",$JOB,FE,FI,N,Q,I,"T")=0
+9 SET M=0
SET (^TMP("WVRES",$JOB,FE,FI,N,Q,"P"),^TMP("WVRES",$JOB,FE,FI,N,Q,"T"),^TMP("WVRES",$JOB,FE,FI,N,Q,"VT","P"),^TMP("WVRES",$JOB,FE,FI,N,Q,"VT","T"))=0
+10 FOR
SET M=$ORDER(^TMP("WV",$JOB,FE,FI,N,Q,M))
if M=""
QUIT
Begin DoDot:3
+11 SET P=-1
SET ^TMP("WVRES",$JOB,FE,FI,N,Q,"P")=^TMP("WVRES",$JOB,FE,FI,N,Q,"P")+1
+12 IF $$GET1^DIQ(2,M,1901,"I")="Y"
SET ^TMP("WVRES",$JOB,FE,FI,N,Q,"VT","PA")=$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,"VT","PA"))+1
+13 FOR
SET P=$ORDER(^TMP("WV",$JOB,FE,FI,N,Q,M,P))
if P=""
QUIT
Begin DoDot:4
+14 SET ^TMP("WVRES",$JOB,FE,FI,N,Q,P,"P")=^TMP("WVRES",$JOB,FE,FI,N,Q,P,"P")+1
+15 SET ^TMP("WVRES",$JOB,FE,FI,N,Q,P,"T")=^TMP("WVRES",$JOB,FE,FI,N,Q,P,"T")+^TMP("WV",$JOB,FE,FI,N,Q,M,P)
+16 IF $$GET1^DIQ(2,M,1901,"I")="Y"
Begin DoDot:5
+17 SET ^TMP("WVRES",$JOB,FE,FI,N,Q,P,"VT","P")=$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,P,"VT","P"))+1
+18 SET ^TMP("WVRES",$JOB,FE,FI,N,Q,P,"VT","T")=$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,P,"VT","T"))+^TMP("WV",$JOB,FE,FI,N,Q,M,P)
End DoDot:5
+19 FOR WVJRC=0,2
Begin DoDot:5
+20 IF $GET(^TMP("WVX",$JOB,FE,FI,N,Q,M,P,WVJRC))'=""
SET ^TMP("WVRES",$JOB,FE,FI,N,Q,"CM","PA",WVJRC)=$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,"CM","PA",WVJRC))+1
Begin DoDot:6
+21 SET ^TMP("WVRES",$JOB,FE,FI,N,Q,P,"CM","P",WVJRC)=$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,P,"CM","P",WVJRC))+1
+22 SET ^TMP("WVRES",$JOB,FE,FI,N,Q,P,"CM","T",WVJRC)=$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,P,"CM","T",WVJRC))+^TMP("WVX",$JOB,FE,FI,N,Q,M,P,WVJRC)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 ;---> NOW COMPUTE TOTAL #PROCEDURES FOR EACH PROCEDURE, EACH AGE GROUP.
+24 SET FE=""
+25 FOR
SET FE=$ORDER(^TMP("WVRES",$JOB,FE))
if FE=""
QUIT
SET FI=0
FOR
SET FI=$ORDER(^TMP("WVRES",$JOB,FE,FI))
if 'FI
QUIT
SET N=0
FOR
SET N=$ORDER(^TMP("WVRES",$JOB,FE,FI,N))
if 'N
QUIT
Begin DoDot:1
+26 SET Q=0
FOR
SET Q=$ORDER(^TMP("WVRES",$JOB,FE,FI,N,Q))
if 'Q
QUIT
Begin DoDot:2
+27 SET M=-1
FOR
SET M=$ORDER(^TMP("WVRES",$JOB,FE,FI,N,Q,M))
if M=""!(M'?1N.N)
QUIT
Begin DoDot:3
+28 SET ^TMP("WVRES",$JOB,FE,FI,N,Q,"T")=^TMP("WVRES",$JOB,FE,FI,N,Q,"T")+^TMP("WVRES",$JOB,FE,FI,N,Q,M,"T")
+29 ;S ^TMP("WVRES",$J,FE,FI,N,Q,"P")=^TMP("WVRES",$J,FE,FI,N,Q,"P")+^TMP("WVRES",$J,FE,FI,N,Q,M,"P")
+30 SET ^TMP("WVRES",$JOB,FE,FI,N,Q,"VT","T")=$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,"VT","T"))+$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,M,"VT","T"))
+31 SET ^TMP("WVRES",$JOB,FE,FI,N,Q,"VT","P")=$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,"VT","P"))+$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,M,"VT","P"))
+32 ;*******************************************
+33 FOR WVJRC=0,2
Begin DoDot:4
+34 SET ^TMP("WVRES",$JOB,FE,FI,N,Q,"CM","T",WVJRC)=$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,"CM","T",WVJRC))+$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,M,"CM","T",WVJRC))
+35 SET ^TMP("WVRES",$JOB,FE,FI,N,Q,"CM","P",WVJRC)=$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,"CM","P",WVJRC))+$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,M,"CM","P",WVJRC))
End DoDot:4
+36 ;*******************************************
End DoDot:3
End DoDot:2
End DoDot:1
+37 ;
+38 ;
+39 ;-> NOW COMPUTE TOTAL #PROCEDURES FOR EACH PROCEDURE.
+40 ;-> ^TMP("WVRES",$J,FE,FI,N,"P")=TOTAL PATIENTS WHO RECEIVED THIS PROCEDURE
+41 ;-> ^TMP("WVRES",$J,FE,FI,N,"T")=TOTAL TIMES THIS PROCEDURE WAS PERFORMED
+42 SET FE=""
+43 FOR
SET FE=$ORDER(^TMP("WVRES",$JOB,FE))
if FE=""
QUIT
SET FI=0
FOR
SET FI=$ORDER(^TMP("WVRES",$JOB,FE,FI))
if 'FI
QUIT
SET N=0
FOR
SET N=$ORDER(^TMP("WVRES",$JOB,FE,FI,N))
if 'N
QUIT
Begin DoDot:1
+44 SET Q=0
SET ^TMP("WVRES",$JOB,FE,FI,N,"P")=0
SET ^TMP("WVRES",$JOB,FE,FI,N,"T")=0
SET ^TMP("WVRES",$JOB,FE,FI,N,"VT","P")=0
+45 SET ^TMP("WVRES",$JOB,FE,FI,N,"VT","T")=0
SET ^TMP("WVRES",$JOB,FE,FI,N,"VT","PA")=0
+46 FOR WVJRC=0,2
SET ^TMP("WVRES",$JOB,FE,FI,N,"CM","T",WVJRC)=0
SET ^TMP("WVRES",$JOB,FE,FI,N,"CM","PA",WVJRC)=0
+47 FOR
SET Q=$ORDER(^TMP("WVRES",$JOB,FE,FI,N,Q))
if 'Q
QUIT
Begin DoDot:2
+48 SET ^TMP("WVRES",$JOB,FE,FI,N,"P")=^TMP("WVRES",$JOB,FE,FI,N,"P")+^TMP("WVRES",$JOB,FE,FI,N,Q,"P")
+49 SET ^TMP("WVRES",$JOB,FE,FI,N,"T")=^TMP("WVRES",$JOB,FE,FI,N,"T")+^TMP("WVRES",$JOB,FE,FI,N,Q,"T")
+50 SET ^TMP("WVRES",$JOB,FE,FI,N,"VT","P")=^TMP("WVRES",$JOB,FE,FI,N,"VT","P")+$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,"VT","P"))
+51 SET ^TMP("WVRES",$JOB,FE,FI,N,"VT","T")=^TMP("WVRES",$JOB,FE,FI,N,"VT","T")+$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,"VT","T"))
+52 SET ^TMP("WVRES",$JOB,FE,FI,N,"VT","PA")=^TMP("WVRES",$JOB,FE,FI,N,"VT","PA")+$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,"VT","PA"))
+53 FOR WVJRC=0,2
Begin DoDot:3
+54 SET ^TMP("WVRES",$JOB,FE,FI,N,"CM","P",WVJRC)=$GET(^TMP("WVRES",$JOB,FE,FI,N,"CM","P",WVJRC))+$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,"CM","P",WVJRC))
+55 SET ^TMP("WVRES",$JOB,FE,FI,N,"CM","T",WVJRC)=$GET(^TMP("WVRES",$JOB,FE,FI,N,"CM","T",WVJRC))+$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,"CM","T",WVJRC))
+56 SET ^TMP("WVRES",$JOB,FE,FI,N,"CM","PA",WVJRC)=$GET(^TMP("WVRES",$JOB,FE,FI,N,"CM","PA",WVJRC))+$GET(^TMP("WVRES",$JOB,FE,FI,N,Q,"CM","PA",WVJRC))
End DoDot:3
End DoDot:2
End DoDot:1
+57 ;
+58 DO FLATFL^WVRPPCD3
+59 QUIT
+60 ;
WVAGE(DFN,DATE,X) ;EP
+1 ;---> SET AGE CATEGORY.
+2 ;---> REQUIRED VARIABLES: DATE=DATE PATIENT RECEIVED THIS PROCEDURE.
+3 ;---> DFN, X=WVAGRG (AGE RANGE).
+4 ;---> IF NOT DISPLAY BY AGE, SET ALL WVAGE=1
+5 if X=1
QUIT 1
+6 NEW AGE,Y,Z
+7 SET AGE=$PIECE($$AGEAT^WVUTL1(DFN,DATE),"y/o")
+8 ;---> RETURN 0 IF PATIENT'S AGE IS UNKNOWN.
+9 if '+AGE
QUIT 0
+10 ;
+11 FOR I=1:1:$LENGTH(X,",")
SET Y=$PIECE($PIECE(X,",",I),"-",2)
if AGE'>Y
QUIT
+12 SET Z=$PIECE($PIECE(X,",",I),"-")
+13 ;---> RETURN 0 IF PATIENT IS OUTSIDE DATE RANGE.
+14 if (AGE<Z!(AGE>Y))
QUIT 0
+15 QUIT Y
FACNAME(IEN) ; Return Facility name
+1 ; Check if ien has been looked up already.
+2 IF $GET(WVHIEN(IEN))]""
QUIT $GET(WVHIEN(IEN))
+3 NEW NAME
+4 ;get facility name
SET NAME=$$INSTTX^WVUTL6(IEN)
+5 IF NAME=""
QUIT ""
+6 ;update local array with name and ien
SET WVHIEN(IEN)=NAME
+7 QUIT NAME
+8 ;
