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

BWMDE.m

Go to the documentation of this file. 
  1. BWMDE ;IHS/ANMC/MWR - EXPORT MDE'S FOR CDC.;29-Oct-2003 21:28;PLS
  1.  ;;2.0;WOMEN'S HEALTH;**3,5,7,8,9**;MAY 16, 1996
  1.  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  CDC EXPORT, MAIN DRIVER FOR COLLECTION AND EXPORT OF DATA TO
  1.  ;;  HOST FILE SERVER.
  1.  ;
  1.  ;IHS/CMI/LAB - patch 3 9/30/98 added age cutoff parameters
  1.  ;IHS/CMI/THL - patch 5 new cde export format
  1.  ;IHS/CMI/THL - patch 8 new cde export content
  1.  ;
  1.  D EXPORT
  1.  Q
  1.  ;
  1.  ;
  1. START ;EP
  1.  ;---> CALLED FROM EXPORT^BWMDE (BELOW).
  1.  D SETVARS^BWUTL5
  1.  D CHECKS^BWMDE4 G:BWPOP EXIT
  1.  D SELECT
  1.  G:BWPOP EXIT
  1.  S DIR(0)="YO",DIR("A")=" Queue EXPORT to run in background",DIR("B")="YES"
  1.  D ^DIR
  1.  K DIR
  1.  I $D(DIRUT) W !!,"EXPORT aborted..." H 3 Q
  1.  I Y=1 D  Q
  1.  . S BWPATH=$P(^BWSITE(DUZ(2),0),U,14)  ;K IO(1)
  1.  . S BWFLNM=$P(^BWSITE(DUZ(2),0),U,13)_$E(DT,4,5)_$E(DT,2,3)_$S($G(BWXPORT):"",1:"LC")_BWCDCV
  1.  . W !!?5,"The file ",BWFLNM," will be available in ",BWPATH
  1.  . W !?5,"after the export is complete which could take up to an hour."
  1.  . D DIRZ^BWUTL3
  1.  . D LOAD(BWBEGDT,BWENDDT,.BWLOC,.BWHCF,.BWCC,.BWPRV,BWCUTF,BWCUTO)
  1. S2 ;FOR SILENT CALL
  1.  D DATA
  1.  G:BWPOP EXIT
  1.  D HFS^BWMDEU1
  1. EXIT ;
  1.  D KILLALL^BWUTL8
  1.  Q
  1.  ;
  1.  ;
  1. LOAD(BWBEGDT,BWENDDT,BWLOC,BWHCF,BWCC,BWPRV,BWCUTF,BWCUTO) ;EP;TO QUEUE EXPORT TO RUN IN BACKGROUND
  1.  ; BWBEGDT - BEGINNING DATE FOR EXPORT
  1.  ; BWENDDT - ENDING DATE FOR EXPORT
  1.  ; BWLOC   - ARRAY OF LOCATIONS TO INCLUDE
  1.  ; BWHCF   - ARRAY OF HEALTH CARE FACILITIES TO INCLUDE
  1.  ; BWCC    - ARRAY OF COMMUNITIES TO INCLUDE
  1.  ; BWPRV   - ARRAY OF PROVIDERS TO INCLUDE
  1.  ; BWCUTF  - YOUNGEST AGE TO INCLUDE
  1.  ; BWCUTO  - OLDEST AGE TO INCLUDE
  1.  S (BWLOC,BWHCF,BWCC,BWPRV)=""
  1.  Q:'$G(BWBEGDT)!'$G(BWENDDT)!'$G(BWCUTF)!'$G(BWCUTO)
  1.  S:'$G(BWLOC) BWLOC("ALL")=""
  1.  S:'$G(BWHCF) BWHCF("ALL")=""
  1.  S:'$G(BWCC) BWCC("ALL")=""
  1.  S:'$G(BWPRV) BWPRV("ALL")=""
  1.  S BWSILENT=""
  1.  S ZTRTN="S1^BWMDE",ZTDESC=$G(BWTITLE,"EXPORT MDE DATA FOR CDC"),ZTDTH=$H,ZTIO=""
  1.  S ZTSAVE("BW*")=""
  1.  D ^%ZTLOAD
  1.  Q
  1.  ;
  1.  ;
  1. S1 ;EP;TO RUN EXPORT IN BACKGROUND
  1.  D SETVARS^BWUTL5
  1.  D CHECKS^BWMDE4 G:BWPOP EXIT
  1.  D S2
  1.  Q
  1.  ;
  1.  ;
  1. SELECT ;EP
  1.  ;---> EXPORT DATA.
  1.  D TITLE^BWUTL5(BWTITLE)
  1.  ;
  1. DATES ;EP
  1.  ; Select data range for export.
  1.  W !!?3,"Select the Date Range for this export."
  1.  W !?5,"The Begin Date may not precede the Date CDC Funding Began,"
  1.  W !?5,"as set on page 2 of the Edit Site Parameters screen."
  1.  W !?5,"The End Date should be the cutoff date for this MDE Submission."
  1.  S BWSTTDT=$P(^BWSITE(DUZ(2),0),U,17)
  1.  D ASKDATES^BWUTL3(.BWBEGDT,.BWENDDT,.BWPOP,BWSTTDT)
  1.  Q:BWPOP
  1.  I BWBEGDT<BWSTTDT D  G DATES
  1.  . W !!?5,"* The Begin Date you have selected is before the Date CDC"
  1.  . W " Funding Began.",!?7,"Please begin again."
  1.  ;
  1.  ; Select cases for one or more ward/clinic/locations (or ALL).
  1.  D SELECT^BWSELECT("Ward/Clinic/Location",44,"BWLOC","","",.BWPOP)
  1.  Q:BWPOP
  1.  ;
  1.  ; Select cases for one or more health care facilities (or ALL).
  1.  D SELECT^BWSELECT("Health Care Facility",9999999.06,"BWHCF","",DUZ(2),.BWPOP)
  1.  Q:BWPOP
  1.  ;
  1.  ; Select cases for one or more current community (or ALL).
  1.  ; Do not prompt for a current community if this is a VA site.
  1.  I $$AGENCY^BWUTL5(DUZ(2))'="i" S BWCC("ALL")=""  ;VAMOD
  1.  E  D SELECT^BWSELECT("Current Community",9999999.05,"BWCC","","",.BWPOP)
  1.  Q:BWPOP
  1.  ;
  1.  ; Select cases for one or more providers ( or ALL).
  1.  D SELECT^BWSELECT("Provider",200,"BWPRV","","",.BWPOP)
  1.  Q:BWPOP
  1.  ;IHS/CMI/LAB - patch 3 added lower and higher age cutoffs 9/30/98
  1.  ;IHS/CMI/LAB - next 17 or so lines added patch 3
  1.  ; Enter an age cutoff.
  1.  N DIR
  1.  W !!,"   Enter a patient age for youngest patient to be exported."
  1.  S DIR("?")="     Procedures for patients under the age you enter will NOT be exported"
  1.  S DIR(0)="N^0:99",DIR("A")="   Enter an age (0-99)",DIR("B")=18 ;IHS/CMI/THL PATCH 8 YOUNGEST AGE 18
  1.  D ^DIR
  1.  K DIR
  1.  W !
  1.  I $D(DIRUT) S BWPOP=1 Q
  1.  S BWCUTF=Y
  1.  N DIR
  1.  W !!,"   Enter a patient age for the oldest patient to be exported."
  1.  S DIR("?")="     Procedures for patients under the age you enter will"
  1.  S DIR("?")=DIR("?")_" NOT be exported"
  1.  S DIR(0)="N^0:99",DIR("A")="   Enter an age (0-99)",DIR("B")=99
  1.  D ^DIR K DIR W !
  1.  I $D(DIRUT) S BWPOP=1 Q
  1.  S BWCUTO=Y
  1.  ;===> IHS/CMI/LAB patch 3  MODS END
  1.  ;
  1.  ; If this is an export, get final okay to continue.
  1.  I BWXPORT D  Q:BWPOP
  1.  . N DIR
  1.  . W !!,"   Do you REALLY wish to export records for CDC now?"
  1.  . S DIR("?")="     Enter YES to export records, enter NO to abort this"
  1.  . S DIR("?")=DIR("?")_" process."
  1.  . S DIR(0)="Y",DIR("A")="   Enter Yes or No",DIR("B")="YES"
  1.  . D ^DIR W !
  1.  . I $D(DIRUT)!(Y=0) W !?25,"* NO RECORDS EXPORTED. *" D DIRZ^BWUTL3  S BWPOP=1
  1.  Q
  1.  ;
  1.  ;
  1. DATA ;EP
  1.  ; Retreive data and store in ^BWTMP(.
  1.  ;
  1.  I '$D(BWSILENT),'$D(ZTQUEUED) W @IOF,!!?3,"Please hold while records are scanned.  This may take several minutes..."
  1.  ;
  1.  ; CDC MDE version# for this export.
  1.  S BWCDCV=$S($P(^BWSITE(DUZ(2),0),U,18):$P(^BWSITE(DUZ(2),0),U,18),1:41)
  1.  ; Test host file access.
  1.  ; If not valid path, will fail with a <MODER>.
  1.  ; Purpose here is to test host file access before flagging procedures as exported.
  1.  S BWPATH=$P(^BWSITE(DUZ(2),0),U,14)  ;K IO(1)
  1.  S BWFLNM=$P(^BWSITE(DUZ(2),0),U,13)_$E(DT,4,5)_$E(DT,2,3)_$S($G(BWXPORT):"",1:"LC")_BWCDCV
  1.  S BWPOP=$$OPEN^%ZISH(BWPATH,BWFLNM,"W")
  1.  D ^%ZISC
  1.  I BWPOP D ERROR^BWMDEU1 S BWPOP=1
  1.  ;
  1.  ;IHS/CMI/THL - patch 5 to use alternate method for cbe/mams
  1.  K ^BWTMP($J)
  1.  S (BWNOFAC,BWOFAC)=0,BWDT=BWBEGDT-.00001,BWENDT=BWENDDT+.99999
  1.  ; Loop through "D" XREF to pickup PCDS to be exported.
  1.  F  S BWDT=$O(^BWPCD("D",BWDT)) Q:'BWDT!(BWDT>BWENDDT)  D
  1.  . S BWIEN=0
  1.  . F  S BWIEN=$O(^BWPCD("D",BWDT,BWIEN)) Q:'BWIEN  D
  1.  . . I '$D(^BWPCD(BWIEN,0)) K ^BWPCD("D",BWDT,BWIEN) Q
  1.  . . Q:$P($G(^BWPCD(BWIEN,3)),U,2)
  1.  . . S BW0=^BWPCD(BWIEN,0),BW2=$G(^BWPCD(BWIEN,2))
  1.  . . ; Quit if this is not a PAP (IEN=1) and not a screening MAM (IEN=28).
  1.  . . ;IHS/CMI/THL - patch 5 to use this section for pap data only
  1.  . . ;Q:$P(BW0,U,4)'=1&($P(BW0,U,4)'=28)  ;IHS/CIM/THL PATCH 8
  1.  . . Q:"^1^28^25^26^"'[(U_$P(BW0,U,4)_U)  ;IHS/CIM/THL PATCH 8
  1.  . . Q:"^25^26^"[(U_$P(BW0,U,4)_U)&($P(BW2,U,32)="")  ;IHS/CIM/THL PATCH 8
  1.  . . I $P(BW0,U,4)=1 S BWPAP=1,BWMAM=0 ;IHS/CIM/THL PATCH 8
  1.  . . I $P(BW0,U,4)'=1 S BWMAM=1,BWPAP=0 ;IHS/CIM/THL PATCH 8
  1.  . . ;
  1.  . . ;; Quit if this procedure has a result of "ERROR/DISREGARD".
  1.  . . Q:$P(BW0,U,5)=8
  1.  . . ;
  1.  . . ; Quit if not selecting all clincs/wards and if this procedure was not performed in one of the clincs/wards selected.
  1.  . . I '$D(BWLOC("ALL")) Q:'$P(BW0,U,11)  Q:'$D(BWLOC($P(BW0,U,11)))
  1.  . . ;
  1.  . . ; Quit if this procedure has no health care facility (store total rejected for no facility in BWNOFAC).
  1.  . . I '$P(BW0,U,10) S BWNOFAC=BWNOFAC+1 Q
  1.  . . ;
  1.  . . ; Quit if not selecting all health care facilities and if this
  1.  . . ; procedure was not performed in one of the facilities selected.
  1.  . . I '$D(BWHCF("ALL")),'$D(BWHCF($P(BW0,U,10))) S BWOFAC=BWOFAC+1 Q
  1.  . . ;
  1.  . . ;IHS/CMI/LAB - patch 3 added age cutoff logic 9/30/97
  1.  . . ; Quit is this patient is below the age cutoff
  1.  . . N BWDFN,AGE
  1.  . . S BWDFN=$P(BW0,U,2)
  1.  . . I $D(BWTSEL),'$D(BWTSEL(+BWDFN)) Q  ; export for selected patients
  1.  . . Q:$G(^DPT(BWDFN,0))["DEMO,"  ;IHS/CMI/THL PATCH 8
  1.  . . Q:'$$INCCHK(BWDFN,$P(BW0,U,12))
  1.  . . ; Retrieve patient's current age or age at time of death
  1.  . . S AGE=+$$AGEAT^BWUTL1(BWDFN,$S(+$$DOD^AUPNPAT(BWDFN):$$DOD^AUPNPAT(BWDFN),1:DT))
  1.  . . Q:BWCUTF>AGE
  1.  . . Q:BWCUTO<AGE
  1.  . . ; Quit if not selecting all current communities and if this
  1.  . . ; procedure was not on a patient in one of the CC's selected.
  1.  . . I '$D(BWCC("ALL")) D  Q:'BWCUR  Q:'$D(BWCC(BWCUR))
  1.  . . . S BWCUR=$$CURCOM^BWUTL1($P(BW0,U,2))
  1.  . . ;
  1.  . . ; Quit if not selecting all providers and if this procedure
  1.  . . ; was not performed by one of the providers selected.
  1.  . . I '$D(BWPRV("ALL")) Q:'$P(BW0,U,7)  Q:'$D(BWPRV($P(BW0,U,7)))
  1.  . . ;
  1.  . . ; Go build the record for this patient
  1.  . . D BUILD^BWMDE1(BWIEN,BWCDCV)
  1.  . . ;
  1.  . . I $P(BW0,U,4)'=1 S ^TMP("BWTPCD",$J,BWIEN)="" ;IHS/CIM/THL PATCH 8
  1.  . . ;
  1.  . . ; Not currently used. Retained in case IMS goes back
  1.  . . ; If this is an export for CDC then update the CDC EXPORT DATE (#.16) and STATUS (#.17) fields.
  1.  . . ; If callled from the "BW CDC EXTRACT FOR LOCAL" option, do not update these fields.
  1.  . . ;D:BWXPORT CDCUPDT^BWPROC(BWIEN)
  1.  ;D ^BWMDET
  1.  Q
  1.  ;
  1.  ; Return Income exclusion flag
  1. INCCHK(BWDFN,PROCDT) ; EP
  1.  ; Input: PROCDT - Date of procedure
  1.  ; Returns: 0=exclude procedure; 1=include procedure
  1.  N ELGV,ELGDT
  1.  Q:'$G(BWDFN)!('$G(PROCDT)) 1  ; include procedure by default
  1.  S ELGV=+$P($G(^BWP(BWDFN,0)),U,29)  ; Income Eligible
  1.  S ELGDT=+$P($G(^BWP(BWDFN,0)),U,30)  ; Income Eligible Date
  1.  Q:'ELGV!('ELGDT) 1  ; include procedure by default
  1.  Q $S(((ELGV=2)&(PROCDT'<ELGDT)):0,1:1)
  1.  ;
  1.  ;
  1. EXPORT ;EP
  1.  ; Called by option "BW CDC EXPORT DATA" exports data.
  1.  ;
  1.  N BWCDCV,BWCUTF,BWCUTO,BWBEGDT,BWENDDT,BWPOP,BWSILENT,BWSTTDT,BWTITLE,BWXPORT
  1.  S BWTITLE="EXPORT MDE DATA FOR CDC",BWXPORT=1
  1.  ; CDC MDE version# for this export.
  1.  S BWCDCV=$S($P(^BWSITE(DUZ(2),0),U,18):$P(^BWSITE(DUZ(2),0),U,18),1:41)
  1.  D START
  1.  Q
  1.  ;
  1.  ;
  1. EXTRACT ;EP
  1.  ;---> * !!NOT USED AT THIS POINT, IMS (CDC CONTRACTOR) DECIDED NOT
  1.  ;---> USE FLAGS.  RETAIN FOR FUTURE, IN CASE THEY SWITCH BACK!!
  1.  N BWCDCV,BWCUTF,BWCUTO,BWBEGDT,BWENDDT,BWPOP,BWSILENT,BWSTTDT,BWTITLE,BWXPORT
  1.  W !!?5,"NOT CURRENTLY FUNCTIONAL." Q
  1.  ;---> CALLED BY OPTION "BW CDC EXTRACT FOR LOCAL", MERELY EXTRACTS
  1.  ;---> CDC DATA TO HOST FILE FOR EVALUATION OR STATISTICAL ANALYSIS
  1.  ;---> LOCALLY, WITHOUT UPDATING BW PROCEDURE CDC STATUS AND DATE
  1.  ;---> FIELDS.
  1.  S BWTITLE="EXTRACT MDE DATA FOR LOCAL ANALYSIS"
  1.  ; CDC MDE version# for this export.
  1.  S BWCDCV=$S($P(^BWSITE(DUZ(2),0),U,18):$P(^BWSITE(DUZ(2),0),U,18),1:41)
  1.  S BWXPORT=0
  1.  D START
  1.  Q