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