- 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 Jan 18, 2025@03:49 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 ;