Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: WVRPPCD2

WVRPPCD2.m

Go to the documentation of this file.
  1. WVRPPCD2 ;HCIOFO/FT,JR-REPORT: PROCEDURES STATISTICS; ;7/24/01 14:11
  1. ;;1.0;WOMEN'S HEALTH;**12**;Sep 30, 1998
  1. ;; Original routine created by IHS/ANMC/MWR
  1. ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1. ;; COLLATING CODE CALLED BY WVRPPCD.
  1. ;
  1. ; This routine uses the following IAs:
  1. ; <NONE>
  1. ;
  1. SORT ;EP
  1. ;---> SORT AND STORE LOCAL ARRAY IN ^TMP("WV",$J,1,
  1. K ^TMP("WV",$J),WVRES,^TMP("WVX",$J),^TMP("WVNOHCF",$J)
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. ;---> WVBEGDT1=ONE SECOND BEFORE BEGIN DATE.
  1. ;---> WVENDDT1=THE LAST SECOND OF END DATE.
  1. N FE,FI,I,WVDFN,WVHCFN,WVHIEN,WVIEN,WVPCD,WVZSTOP,Y
  1. S WVBEGDT1=WVBEGDT-.0001,WVENDDT1=WVENDDT+.9999
  1. S WVDATE=WVBEGDT1,WVZSTOP=0
  1. F S WVDATE=$O(^WV(790.1,"D",WVDATE)) Q:'WVDATE!(WVDATE>WVENDDT1)!($G(ZTSTOP)=1) D
  1. .S WVIEN=0
  1. .F S WVIEN=$O(^WV(790.1,"D",WVDATE,WVIEN)) Q:'WVIEN!($G(ZTSTOP)=1) D
  1. ..S WVZSTOP=WVZSTOP+1
  1. ..;If background task, then every 100 records check if user wants to
  1. ..;stop the task.
  1. ..I $D(ZTQUEUED),WVZSTOP#100=0 D STOPCHK^WVUTL10(0) Q:$G(ZTSTOP)=1
  1. ..S Y=^WV(790.1,WVIEN,0)
  1. ..;---> QUIT IF THIS PROCEDURE HAS A RESULT OF "ERROR/DISREGARD".
  1. ..Q:$P(Y,U,5)=8
  1. ..S WVDFN=$P(Y,U,2),WVPCD=$P(Y,U,4),WVHCF=$P(Y,U,10) ;patient ien, procedure ien, facility ien
  1. ..I 'WVHCF S ^TMP("WVNOHCF",$J,WVIEN)="" Q ;no facility
  1. ..S WVHCFN=$$FACNAME(WVHCF)
  1. ..I WVHCFN="" S ^TMP("WVNOHCF",$J,WVIEN)="" Q ;no facility name
  1. ..S WVAGE=$$WVAGE(WVDFN,$P(Y,U,12),WVAGRG)
  1. ..;---> QUIT IF PATIENT'S AGE IS UNKNOWN OR OUTSIDE OF AGE RANGE.
  1. ..Q:'WVAGE
  1. ..;---> QUIT IF NOT SELECTING FOR ALL PROCEDURES AND IF THIS IS
  1. ..;---> NOT ONE OF THE SELECTED PROCEDURES.
  1. ..I '$D(WVARR("ALL")) Q:'$D(WVARR(WVPCD))
  1. ..;---> Quit if Facility is not one selected by user
  1. ..I '$D(WVSB("ALL")) Q:'$D(WVSB(WVHCF))
  1. ..;---> FOR WVRES: 0=NORMAL, 1=ABNORMAL, 2=NO RESULT.
  1. ..S WVRES=$$NORMAL^WVUTL4($P(Y,U,5))
  1. ..; Below 5 Lines added to gather Rad Credit for rept
  1. ..S WVJRC=$P($G(^WV(790.1,WVIEN,0)),U,35) I WVJRC'="" D
  1. ...I '$D(^TMP("WVX",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES,WVJRC)) D Q
  1. ....S ^TMP("WVX",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES,WVJRC)=1
  1. ...S X=^TMP("WVX",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES,WVJRC)+1
  1. ...S ^TMP("WVX",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES,WVJRC)=X
  1. ..I '$D(^TMP("WV",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES)) D Q
  1. ...S ^TMP("WV",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES)=1
  1. ..S X=^TMP("WV",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES)+1
  1. ..S ^TMP("WV",$J,WVHCFN,WVHCF,WVPCD,WVAGE,WVDFN,WVRES)=X
  1. ..Q
  1. .Q
  1. Q:$G(ZTSTOP)=1 ;user stopped the background task
  1. ;
  1. TOTALS ;EP
  1. ;---> N=WVPCD, Q=WVAGE, M=WVDFN, P=WVRES (0,1,2), FI=WVHCF(internal)
  1. ;---> FE=WVHCF(external)
  1. N I,M,N,P,Q
  1. S FE=""
  1. 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
  1. .S Q=0
  1. .F S Q=$O(^TMP("WV",$J,FE,FI,N,Q)) Q:Q="" D
  1. ..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
  1. ..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
  1. ..F S M=$O(^TMP("WV",$J,FE,FI,N,Q,M)) Q:M="" D
  1. ...S P=-1,^TMP("WVRES",$J,FE,FI,N,Q,"P")=^TMP("WVRES",$J,FE,FI,N,Q,"P")+1
  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
  1. ...F S P=$O(^TMP("WV",$J,FE,FI,N,Q,M,P)) Q:P="" D
  1. ....S ^TMP("WVRES",$J,FE,FI,N,Q,P,"P")=^TMP("WVRES",$J,FE,FI,N,Q,P,"P")+1
  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)
  1. ....I $$GET1^DIQ(2,M,1901,"I")="Y" D
  1. .....S ^TMP("WVRES",$J,FE,FI,N,Q,P,"VT","P")=$G(^TMP("WVRES",$J,FE,FI,N,Q,P,"VT","P"))+1
  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)
  1. ....F WVJRC=0,2 D
  1. .....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
  1. ......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
  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)
  1. ;---> NOW COMPUTE TOTAL #PROCEDURES FOR EACH PROCEDURE, EACH AGE GROUP.
  1. S FE=""
  1. 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
  1. .S Q=0 F S Q=$O(^TMP("WVRES",$J,FE,FI,N,Q)) Q:'Q D
  1. ..S M=-1 F S M=$O(^TMP("WVRES",$J,FE,FI,N,Q,M)) Q:M=""!(M'?1N.N) D
  1. ...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")
  1. ...;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")
  1. ...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"))
  1. ...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"))
  1. ...;*******************************************
  1. ...F WVJRC=0,2 D
  1. ....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))
  1. ....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))
  1. ...;*******************************************
  1. ;
  1. ;
  1. ;-> NOW COMPUTE TOTAL #PROCEDURES FOR EACH PROCEDURE.
  1. ;-> ^TMP("WVRES",$J,FE,FI,N,"P")=TOTAL PATIENTS WHO RECEIVED THIS PROCEDURE
  1. ;-> ^TMP("WVRES",$J,FE,FI,N,"T")=TOTAL TIMES THIS PROCEDURE WAS PERFORMED
  1. S FE=""
  1. 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
  1. .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
  1. .S ^TMP("WVRES",$J,FE,FI,N,"VT","T")=0,^TMP("WVRES",$J,FE,FI,N,"VT","PA")=0
  1. .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
  1. .F S Q=$O(^TMP("WVRES",$J,FE,FI,N,Q)) Q:'Q D
  1. ..S ^TMP("WVRES",$J,FE,FI,N,"P")=^TMP("WVRES",$J,FE,FI,N,"P")+^TMP("WVRES",$J,FE,FI,N,Q,"P")
  1. ..S ^TMP("WVRES",$J,FE,FI,N,"T")=^TMP("WVRES",$J,FE,FI,N,"T")+^TMP("WVRES",$J,FE,FI,N,Q,"T")
  1. ..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"))
  1. ..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"))
  1. ..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"))
  1. ..F WVJRC=0,2 D
  1. ...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))
  1. ...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))
  1. ...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))
  1. ;
  1. D FLATFL^WVRPPCD3
  1. Q
  1. ;
  1. WVAGE(DFN,DATE,X) ;EP
  1. ;---> SET AGE CATEGORY.
  1. ;---> REQUIRED VARIABLES: DATE=DATE PATIENT RECEIVED THIS PROCEDURE.
  1. ;---> DFN, X=WVAGRG (AGE RANGE).
  1. ;---> IF NOT DISPLAY BY AGE, SET ALL WVAGE=1
  1. Q:X=1 1
  1. N AGE,Y,Z
  1. S AGE=$P($$AGEAT^WVUTL1(DFN,DATE),"y/o")
  1. ;---> RETURN 0 IF PATIENT'S AGE IS UNKNOWN.
  1. Q:'+AGE 0
  1. ;
  1. F I=1:1:$L(X,",") S Y=$P($P(X,",",I),"-",2) Q:AGE'>Y
  1. S Z=$P($P(X,",",I),"-")
  1. ;---> RETURN 0 IF PATIENT IS OUTSIDE DATE RANGE.
  1. Q:(AGE<Z!(AGE>Y)) 0
  1. Q Y
  1. FACNAME(IEN) ; Return Facility name
  1. ; Check if ien has been looked up already.
  1. I $G(WVHIEN(IEN))]"" Q $G(WVHIEN(IEN))
  1. N NAME
  1. S NAME=$$INSTTX^WVUTL6(IEN) ;get facility name
  1. I NAME="" Q ""
  1. S WVHIEN(IEN)=NAME ;update local array with name and ien
  1. Q NAME
  1. ;