BWMDEX ;IHS/CIA/DKM - EXPORT MDE'S FOR CDC.;06-Oct-2003 15:36;DKM
;;2.0;WOMEN'S HEALTH;**9,12**;MAY 16, 1996
;CIA/DKM - patch 9 complete rewrite of MDE
EXPORT ; EP: Called by option BW CDC EXPORT DATA.
D START(0,"MDE DATA EXTRACT FOR CDC",3,$$CDCFMT)
Q
ADHOC ; EP: Adhoc extracts
D START(1,"MDE DATA ADHOC EXTRACT",2)
Q
;
; Common EP for all extracts.
START(BWADHOC,BWTITLE,BWSET,BWFMT) ;
N BWPATH,BWFILE,BWPOP,BWSILENT,BWFLT,BWTASK,Y
D SETVARS^BWUTL5
D CHECKS^BWMDE4
Q:BWPOP
D TITLE^BWUTL5(BWTITLE),FILTER(.BWSET,.BWFLT)
Q:BWPOP
D FLTDSPL(BWSET,.BWFLT)
S:'$G(BWFMT) BWFMT=$$GETIEN^BWUTLP(9002086.96,"Select an extract format: ")
Q:BWPOP
S BWTASK=$$DIRYN^BWUTLP("Queue extract to run in background","NO",,.BWPOP)
Q:BWPOP
I BWTASK D
.Q:$$HFSOPEN^BWMDEX1(.BWFILE,.BWPATH,1)
.S ZTRTN="START2^BWMDEX",ZTDESC=BWTITLE,ZTDTH=$H,ZTIO="",ZTSAVE("BW*")="",BWSILENT=""
.D ^%ZTLOAD
.K BWSILENT
.D SHOWDLG^BWUTLP(-11_U_ZTSK_U_BWFILE_U_BWPATH)
E D SHOWDLG^BWUTLP(8),START2,COUNTS(.BWFLT)
Q
; Entry point for background and foreground search.
START2 N BWGBL
S BWGBL=$NA(^BWTMP($J))
D SEARCH(.BWFLT,.BWFMT,BWGBL)
D:'BWPOP OUTPUT^BWMDEX1(BWGBL,BWADHOC,.BWFILE)
Q
; Called by RPC to perform extract
; BWADHOC = 1=Ad hoc extract, 0=CDC export (Make entry in Log File)
; BWBEGDT = Beginning date for export
; BWENDDT = Ending date for export
; BWLOC = Array of locations to include
; BWHCF = Array of 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
LOAD(BWADHOC,BWBEGDT,BWENDDT,BWLOC,BWHCF,BWCC,BWPRV,BWCUTF,BWCUTO) ;
N BWFLT,BWGBL,BWSILENT,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
D FILTER(1,.BWFLT,1)
S BWFLT(1,"V",BWCUTF)="",BWFLT(1,"V",BWCUTO)=""
M BWFLT(2,"V")=BWLOC
M BWFLT(3,"V")=BWHCF
M BWFLT(4,"V")=BWCC
S BWFLT(5,"V",BWBEGDT)="",BWFLT(5,"V",BWENDDT)=""
M BWFLT(6,"V")=BWPRV
S BWGBL=$NA(^BWTMP($J))
S BWSILENT=1
S ZTRTN="LOAD1^BWMDEX",ZTDESC=$G(BWTITLE,"EXPORT MDE DATA FOR CDC"),ZTDTH=$H,ZTIO="",ZTSAVE("BW*")=""
D ^%ZTLOAD
Q
; Taskman entry point for LOAD
LOAD1 D SEARCH(.BWFLT,$$CDCFMT,BWGBL)
D OUTPUT^BWMDEX1(BWGBL,BWADHOC)
Q
;
; Filter setup
; .BWSET = IEN of filter set (prompted if not given)
; .BWFLT = Filter array to build
; BWSILENT = Suppresses prompt (optional)
;
FILTER(BWSET,BWFLT,BWSILENT) ;
N BWSEQ,BWVAL,BWSEP,X,Y
K BWFLT
S:'$G(BWSET) BWSET=$$GETIEN^BWUTLP(9002086.95,"Choose a filter set: ")
Q:BWPOP
S BWSEQ=0,BWSEP=$$REPEAT^XLFSTR("-",80)
F S BWSEQ=$O(^BWFLT2(BWSET,1,"AC",BWSEQ)),BWFLT=0 Q:'BWSEQ!BWPOP D
.F S BWFLT=$O(^BWFLT2(BWSET,1,"AC",BWSEQ,BWFLT)) Q:'BWFLT!BWPOP D
..S BWFLT(BWFLT,"F")=$G(^BWFLT(BWFLT,1)),BWSEP(0)=1
..S BWFLT(BWFLT,"N")=''$P(^BWFLT2(BWSET,1,BWFLT,0),U,3)
..I '$D(BWSILENT),$P(^BWFLT2(BWSET,1,BWFLT,0),U,4),'$$FLTINC K BWFLT(BWFLT) Q
..I $O(^BWFLT2(BWSET,1,BWFLT,1,0)) D
...S BWVAL=0
...F S BWVAL=$O(^BWFLT2(BWSET,1,BWFLT,1,BWVAL)) Q:'BWVAL S BWFLT(BWFLT,"V",^(BWVAL,0))=""
..E I '$D(BWSILENT),$L($G(^BWFLT(BWFLT,2))) D
...W !,$$SEP
...X ^BWFLT(BWFLT,2)
..S X=$G(^BWFLT(BWFLT,4))
..Q:'$L($P(X,U))
..I $D(BWFLT("I")),BWFLT("I",2)>$P(X,U,2) Q
..F Y=1:1:3 S BWFLT("I",Y)=$P(X,U,Y)
..S BWFLT("I",0)=BWFLT
K:BWPOP BWFLT
W:'$D(BWSILENT) !,BWSEP,!
Q
; Returns "include" or "exclude" for filter
INCEXC(BWFLX,BWCAP) ;
N X
S X=$S(BWFLT(BWFLX,"N"):"ex",1:"in")_"clude "
S:$G(BWCAP) $E(X)=$C($A(X)-32)
Q X
; Prompt for inclusion of filter
FLTINC() W !!,$$SEP,$$INCEXC(BWFLT,1),$P(^BWFLT(BWFLT,0),U,2),"."
Q $$DIRYN^BWUTLP(19,"NO",20,.BWPOP)
; Write separator if not already done
SEP() W:BWSEP(0) BWSEP,!
S BWSEP(0)=0
Q ""
; Display filter settings
FLTDSPL(BWSET,BWFLT) ;
N BWSEQ
S BWSEQ=0
W !!,"Criteria settings for ",$$GET1^DIQ(9002086.95,BWSET,.01),":",!!
F S BWSEQ=$O(^BWFLT2(BWSET,1,"AC",BWSEQ)),BWFLT=0 Q:'BWSEQ D
.F S BWFLT=$O(^BWFLT2(BWSET,1,"AC",BWSEQ,BWFLT)) Q:'BWFLT D
..I $D(BWFLT(BWFLT)),$D(^BWFLT(BWFLT,3)) W "Will "_$$INCEXC(BWFLT) X ^(3)
W !!
Q
;
; Retrieve data and store in target global.
SEARCH(BWFLT,BWFMT,BWGBL) ;
N BWIEN,BWDATA,BWPT,BWDFN,BWFAC,BWDT,BWPAP,BWMAM,BWCBE,BWDOT
S (BWDOT,BWIEN)=0
K @BWGBL
D RESETCNT(.BWFLT)
F D NXTIEN Q:'BWIEN D
.I '$D(BWSILENT),'$D(ZTQUEUED) S BWDOT=BWDOT+1#100 W:'BWDOT "."
.D LOADDATA(BWIEN)
.Q:'BWPT ; Ignore if no procedure type
.Q:$$PC(3,2) ; Ignore if not marked for export
.Q:$$PC(0,5)=8 ; Ignore if marked as ERROR/DISREGARD.
.Q:$E($G(^DPT(BWDFN,0)),1,5)="DEMO," ; Exclude demo patients
.; Now check against active filter set
.S BWFLT=0,BWFLT("C")=BWFLT("C")+1
.F S BWFLT=$O(BWFLT(BWFLT)) Q:'BWFLT I 1 X BWFLT(BWFLT,"F") Q:'BWFLT(BWFLT,"N")-$T
.I BWFLT S BWFLT(BWFLT,"C")=BWFLT(BWFLT,"C")+1 Q
.S BWFLT(0,"C")=BWFLT(0,"C")+1
.D EXPORT^BWMDEX1(.BWFMT,BWIEN,BWGBL) ; Build the export record for this patient
.S:BWPT'=1 ^TMP("BWTPCD",$J,BWIEN)="" ;IHS/CIM/THL PATCH 8
Q
; Return next IEN in sequence
NXTIEN I '$D(BWFLT("I")) S BWIEN=$O(^BWPCD(BWIEN)) Q
S:'BWIEN BWFLT("I")=$O(BWFLT(BWFLT("I",0),"V",""))
I '$L(BWFLT("I")) S BWIEN=0 Q
I BWFLT("I",3) D
.F Q:'$L(BWFLT("I")) D Q:BWIEN
..S BWIEN=$O(^BWPCD(BWFLT("I",1),BWFLT("I"),BWIEN))
..S:'BWIEN BWFLT("I")=$O(BWFLT(BWFLT("I",0),"V",BWFLT("I")))
E D
.S:'$D(BWFLT("I",-1)) BWFLT("I",-1)=$O(BWFLT(BWFLT("I",0),"V",""),-1)
.F Q:BWFLT("I")>BWFLT("I",-1)!'BWFLT("I") D Q:BWIEN
..S BWIEN=$O(^BWPCD(BWFLT("I",1),BWFLT("I"),BWIEN))
..S:'BWIEN BWFLT("I")=$O(^BWPCD(BWFLT("I",1),BWFLT("I")))
Q
; Show results of search
COUNTS(BWFLT) ;
W !!
D DCNT("Records considered",BWFLT("C"))
D DCNT("Records selected",BWFLT(0,"C"))
D DCNT("Records rejected",BWFLT("C")-BWFLT(0,"C"))
S BWFLT=0
F S BWFLT=$O(BWFLT(BWFLT)) Q:'BWFLT D
.Q:BWFLT=$G(BWFLT("I",0))
.D DCNT($S(BWFLT(BWFLT,"N"):"~",1:" ")_$$GET1^DIQ(9002086.94,BWFLT,.01),BWFLT(BWFLT,"C"),5)
W !!
Q
; Display count
DCNT(BWLBL,BWCNT,BWIND) ;
W ?$G(BWIND),BWLBL,?25,":",?30,$J(+BWCNT,6),!
Q
; Reset counts
RESETCNT(BWFLT) ;
S BWFLT("C")=0,BWFLT=0
F S BWFLT(BWFLT,"C")=0,BWFLT=$O(BWFLT(BWFLT)) Q:'BWFLT
Q
; Load data from specified record
; Sets up the following data:
; BWDATA = Merged from record identified by BWIEN
; BWDFN = Patient IEN
; BWPT = Procedure type
; BWFAC = Facility
; BWDT = Procedure date
; BWPAP = True if PAP
; BWMAM = True if Mammogram
; BWCBE = True if Standalone CBE
LOADDATA(BWIEN) ; EP
K BWDATA
M BWDATA=^BWPCD(BWIEN)
S BWDFN=$$PC(0,2),BWPT=$$PC(0,4),BWFAC=$$PC(0,10),BWDT=$$PC(0,12)
S BWPAP=BWPT=1,BWMAM="^25^26^28^"[(U_BWPT_U),BWCBE=BWPT=27
Q
; Return IEN of export format for default CDC version
CDCFMT() Q +$O(^BWFMT("B","CDC"_$$CDCVER^BWMDEX2,0))
; Return data from specified node and piece
; BWN = Node subscript
; BWP = Data piece (defaults to 1)
; BWT = If specified and zero, forces null return value
PC(BWN,BWP,BWT) ; EP
Q $S($G(BWT)=0:"",1:$P($G(BWDATA(BWN)),U,$G(BWP,1)))
BWMDEX ;IHS/CIA/DKM - EXPORT MDE'S FOR CDC.;06-Oct-2003 15:36;DKM
+1 ;;2.0;WOMEN'S HEALTH;**9,12**;MAY 16, 1996
+2 ;CIA/DKM - patch 9 complete rewrite of MDE
EXPORT ; EP: Called by option BW CDC EXPORT DATA.
+1 DO START(0,"MDE DATA EXTRACT FOR CDC",3,$$CDCFMT)
+2 QUIT
ADHOC ; EP: Adhoc extracts
+1 DO START(1,"MDE DATA ADHOC EXTRACT",2)
+2 QUIT
+3 ;
+4 ; Common EP for all extracts.
START(BWADHOC,BWTITLE,BWSET,BWFMT) ;
+1 NEW BWPATH,BWFILE,BWPOP,BWSILENT,BWFLT,BWTASK,Y
+2 DO SETVARS^BWUTL5
+3 DO CHECKS^BWMDE4
+4 IF BWPOP
QUIT
+5 DO TITLE^BWUTL5(BWTITLE)
DO FILTER(.BWSET,.BWFLT)
+6 IF BWPOP
QUIT
+7 DO FLTDSPL(BWSET,.BWFLT)
+8 IF '$GET(BWFMT)
SET BWFMT=$$GETIEN^BWUTLP(9002086.96,"Select an extract format: ")
+9 IF BWPOP
QUIT
+10 SET BWTASK=$$DIRYN^BWUTLP("Queue extract to run in background","NO",,.BWPOP)
+11 IF BWPOP
QUIT
+12 IF BWTASK
Begin DoDot:1
+13 IF $$HFSOPEN^BWMDEX1(.BWFILE,.BWPATH,1)
QUIT
+14 SET ZTRTN="START2^BWMDEX"
SET ZTDESC=BWTITLE
SET ZTDTH=$HOROLOG
SET ZTIO=""
SET ZTSAVE("BW*")=""
SET BWSILENT=""
+15 DO ^%ZTLOAD
+16 KILL BWSILENT
+17 DO SHOWDLG^BWUTLP(-11_U_ZTSK_U_BWFILE_U_BWPATH)
End DoDot:1
+18 IF '$TEST
DO SHOWDLG^BWUTLP(8)
DO START2
DO COUNTS(.BWFLT)
+19 QUIT
+20 ; Entry point for background and foreground search.
START2 NEW BWGBL
+1 SET BWGBL=$NAME(^BWTMP($JOB))
+2 DO SEARCH(.BWFLT,.BWFMT,BWGBL)
+3 IF 'BWPOP
DO OUTPUT^BWMDEX1(BWGBL,BWADHOC,.BWFILE)
+4 QUIT
+5 ; Called by RPC to perform extract
+6 ; BWADHOC = 1=Ad hoc extract, 0=CDC export (Make entry in Log File)
+7 ; BWBEGDT = Beginning date for export
+8 ; BWENDDT = Ending date for export
+9 ; BWLOC = Array of locations to include
+10 ; BWHCF = Array of facilities to include
+11 ; BWCC = Array of communities to include
+12 ; BWPRV = Array of providers to include
+13 ; BWCUTF = Youngest age to include
+14 ; BWCUTO = Oldest age to include
LOAD(BWADHOC,BWBEGDT,BWENDDT,BWLOC,BWHCF,BWCC,BWPRV,BWCUTF,BWCUTO) ;
+1 NEW BWFLT,BWGBL,BWSILENT,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
+2 DO FILTER(1,.BWFLT,1)
+3 SET BWFLT(1,"V",BWCUTF)=""
SET BWFLT(1,"V",BWCUTO)=""
+4 MERGE BWFLT(2,"V")=BWLOC
+5 MERGE BWFLT(3,"V")=BWHCF
+6 MERGE BWFLT(4,"V")=BWCC
+7 SET BWFLT(5,"V",BWBEGDT)=""
SET BWFLT(5,"V",BWENDDT)=""
+8 MERGE BWFLT(6,"V")=BWPRV
+9 SET BWGBL=$NAME(^BWTMP($JOB))
+10 SET BWSILENT=1
+11 SET ZTRTN="LOAD1^BWMDEX"
SET ZTDESC=$GET(BWTITLE,"EXPORT MDE DATA FOR CDC")
SET ZTDTH=$HOROLOG
SET ZTIO=""
SET ZTSAVE("BW*")=""
+12 DO ^%ZTLOAD
+13 QUIT
+14 ; Taskman entry point for LOAD
LOAD1 DO SEARCH(.BWFLT,$$CDCFMT,BWGBL)
+1 DO OUTPUT^BWMDEX1(BWGBL,BWADHOC)
+2 QUIT
+3 ;
+4 ; Filter setup
+5 ; .BWSET = IEN of filter set (prompted if not given)
+6 ; .BWFLT = Filter array to build
+7 ; BWSILENT = Suppresses prompt (optional)
+8 ;
FILTER(BWSET,BWFLT,BWSILENT) ;
+1 NEW BWSEQ,BWVAL,BWSEP,X,Y
+2 KILL BWFLT
+3 IF '$GET(BWSET)
SET BWSET=$$GETIEN^BWUTLP(9002086.95,"Choose a filter set: ")
+4 IF BWPOP
QUIT
+5 SET BWSEQ=0
SET BWSEP=$$REPEAT^XLFSTR("-",80)
+6 FOR
SET BWSEQ=$ORDER(^BWFLT2(BWSET,1,"AC",BWSEQ))
SET BWFLT=0
IF 'BWSEQ!BWPOP
QUIT
Begin DoDot:1
+7 FOR
SET BWFLT=$ORDER(^BWFLT2(BWSET,1,"AC",BWSEQ,BWFLT))
IF 'BWFLT!BWPOP
QUIT
Begin DoDot:2
+8 SET BWFLT(BWFLT,"F")=$GET(^BWFLT(BWFLT,1))
SET BWSEP(0)=1
+9 SET BWFLT(BWFLT,"N")=''$PIECE(^BWFLT2(BWSET,1,BWFLT,0),U,3)
+10 IF '$DATA(BWSILENT)
IF $PIECE(^BWFLT2(BWSET,1,BWFLT,0),U,4)
IF '$$FLTINC
KILL BWFLT(BWFLT)
QUIT
+11 IF $ORDER(^BWFLT2(BWSET,1,BWFLT,1,0))
Begin DoDot:3
+12 SET BWVAL=0
+13 FOR
SET BWVAL=$ORDER(^BWFLT2(BWSET,1,BWFLT,1,BWVAL))
IF 'BWVAL
QUIT
SET BWFLT(BWFLT,"V",^(BWVAL,0))=""
End DoDot:3
+14 IF '$TEST
IF '$DATA(BWSILENT)
IF $LENGTH($GET(^BWFLT(BWFLT,2)))
Begin DoDot:3
+15 WRITE !,$$SEP
+16 XECUTE ^BWFLT(BWFLT,2)
End DoDot:3
+17 SET X=$GET(^BWFLT(BWFLT,4))
+18 IF '$LENGTH($PIECE(X,U))
QUIT
+19 IF $DATA(BWFLT("I"))
IF BWFLT("I",2)>$PIECE(X,U,2)
QUIT
+20 FOR Y=1:1:3
SET BWFLT("I",Y)=$PIECE(X,U,Y)
+21 SET BWFLT("I",0)=BWFLT
End DoDot:2
End DoDot:1
+22 IF BWPOP
KILL BWFLT
+23 IF '$DATA(BWSILENT)
WRITE !,BWSEP,!
+24 QUIT
+25 ; Returns "include" or "exclude" for filter
INCEXC(BWFLX,BWCAP) ;
+1 NEW X
+2 SET X=$SELECT(BWFLT(BWFLX,"N"):"ex",1:"in")_"clude "
+3 IF $GET(BWCAP)
SET $EXTRACT(X)=$CHAR($ASCII(X)-32)
+4 QUIT X
+5 ; Prompt for inclusion of filter
FLTINC() WRITE !!,$$SEP,$$INCEXC(BWFLT,1),$PIECE(^BWFLT(BWFLT,0),U,2),"."
+1 QUIT $$DIRYN^BWUTLP(19,"NO",20,.BWPOP)
+2 ; Write separator if not already done
SEP() IF BWSEP(0)
WRITE BWSEP,!
+1 SET BWSEP(0)=0
+2 QUIT ""
+3 ; Display filter settings
FLTDSPL(BWSET,BWFLT) ;
+1 NEW BWSEQ
+2 SET BWSEQ=0
+3 WRITE !!,"Criteria settings for ",$$GET1^DIQ(9002086.95,BWSET,.01),":",!!
+4 FOR
SET BWSEQ=$ORDER(^BWFLT2(BWSET,1,"AC",BWSEQ))
SET BWFLT=0
IF 'BWSEQ
QUIT
Begin DoDot:1
+5 FOR
SET BWFLT=$ORDER(^BWFLT2(BWSET,1,"AC",BWSEQ,BWFLT))
IF 'BWFLT
QUIT
Begin DoDot:2
+6 IF $DATA(BWFLT(BWFLT))
IF $DATA(^BWFLT(BWFLT,3))
WRITE "Will "_$$INCEXC(BWFLT)
XECUTE ^(3)
End DoDot:2
End DoDot:1
+7 WRITE !!
+8 QUIT
+9 ;
+10 ; Retrieve data and store in target global.
SEARCH(BWFLT,BWFMT,BWGBL) ;
+1 NEW BWIEN,BWDATA,BWPT,BWDFN,BWFAC,BWDT,BWPAP,BWMAM,BWCBE,BWDOT
+2 SET (BWDOT,BWIEN)=0
+3 KILL @BWGBL
+4 DO RESETCNT(.BWFLT)
+5 FOR
DO NXTIEN
IF 'BWIEN
QUIT
Begin DoDot:1
+6 IF '$DATA(BWSILENT)
IF '$DATA(ZTQUEUED)
SET BWDOT=BWDOT+1#100
IF 'BWDOT
WRITE "."
+7 DO LOADDATA(BWIEN)
+8 ; Ignore if no procedure type
IF 'BWPT
QUIT
+9 ; Ignore if not marked for export
IF $$PC(3,2)
QUIT
+10 ; Ignore if marked as ERROR/DISREGARD.
IF $$PC(0,5)=8
QUIT
+11 ; Exclude demo patients
IF $EXTRACT($GET(^DPT(BWDFN,0)),1,5)="DEMO,"
QUIT
+12 ; Now check against active filter set
+13 SET BWFLT=0
SET BWFLT("C")=BWFLT("C")+1
+14 FOR
SET BWFLT=$ORDER(BWFLT(BWFLT))
IF 'BWFLT
QUIT
IF 1
XECUTE BWFLT(BWFLT,"F")
IF 'BWFLT(BWFLT,"N")-$TEST
QUIT
+15 IF BWFLT
SET BWFLT(BWFLT,"C")=BWFLT(BWFLT,"C")+1
QUIT
+16 SET BWFLT(0,"C")=BWFLT(0,"C")+1
+17 ; Build the export record for this patient
DO EXPORT^BWMDEX1(.BWFMT,BWIEN,BWGBL)
+18 ;IHS/CIM/THL PATCH 8
IF BWPT'=1
SET ^TMP("BWTPCD",$JOB,BWIEN)=""
End DoDot:1
+19 QUIT
+20 ; Return next IEN in sequence
NXTIEN IF '$DATA(BWFLT("I"))
SET BWIEN=$ORDER(^BWPCD(BWIEN))
QUIT
+1 IF 'BWIEN
SET BWFLT("I")=$ORDER(BWFLT(BWFLT("I",0),"V",""))
+2 IF '$LENGTH(BWFLT("I"))
SET BWIEN=0
QUIT
+3 IF BWFLT("I",3)
Begin DoDot:1
+4 FOR
IF '$LENGTH(BWFLT("I"))
QUIT
Begin DoDot:2
+5 SET BWIEN=$ORDER(^BWPCD(BWFLT("I",1),BWFLT("I"),BWIEN))
+6 IF 'BWIEN
SET BWFLT("I")=$ORDER(BWFLT(BWFLT("I",0),"V",BWFLT("I")))
End DoDot:2
IF BWIEN
QUIT
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 IF '$DATA(BWFLT("I",-1))
SET BWFLT("I",-1)=$ORDER(BWFLT(BWFLT("I",0),"V",""),-1)
+9 FOR
IF BWFLT("I")>BWFLT("I",-1)!'BWFLT("I")
QUIT
Begin DoDot:2
+10 SET BWIEN=$ORDER(^BWPCD(BWFLT("I",1),BWFLT("I"),BWIEN))
+11 IF 'BWIEN
SET BWFLT("I")=$ORDER(^BWPCD(BWFLT("I",1),BWFLT("I")))
End DoDot:2
IF BWIEN
QUIT
End DoDot:1
+12 QUIT
+13 ; Show results of search
COUNTS(BWFLT) ;
+1 WRITE !!
+2 DO DCNT("Records considered",BWFLT("C"))
+3 DO DCNT("Records selected",BWFLT(0,"C"))
+4 DO DCNT("Records rejected",BWFLT("C")-BWFLT(0,"C"))
+5 SET BWFLT=0
+6 FOR
SET BWFLT=$ORDER(BWFLT(BWFLT))
IF 'BWFLT
QUIT
Begin DoDot:1
+7 IF BWFLT=$GET(BWFLT("I",0))
QUIT
+8 DO DCNT($SELECT(BWFLT(BWFLT,"N"):"~",1:" ")_$$GET1^DIQ(9002086.94,BWFLT,.01),BWFLT(BWFLT,"C"),5)
End DoDot:1
+9 WRITE !!
+10 QUIT
+11 ; Display count
DCNT(BWLBL,BWCNT,BWIND) ;
+1 WRITE ?$GET(BWIND),BWLBL,?25,":",?30,$JUSTIFY(+BWCNT,6),!
+2 QUIT
+3 ; Reset counts
RESETCNT(BWFLT) ;
+1 SET BWFLT("C")=0
SET BWFLT=0
+2 FOR
SET BWFLT(BWFLT,"C")=0
SET BWFLT=$ORDER(BWFLT(BWFLT))
IF 'BWFLT
QUIT
+3 QUIT
+4 ; Load data from specified record
+5 ; Sets up the following data:
+6 ; BWDATA = Merged from record identified by BWIEN
+7 ; BWDFN = Patient IEN
+8 ; BWPT = Procedure type
+9 ; BWFAC = Facility
+10 ; BWDT = Procedure date
+11 ; BWPAP = True if PAP
+12 ; BWMAM = True if Mammogram
+13 ; BWCBE = True if Standalone CBE
LOADDATA(BWIEN) ; EP
+1 KILL BWDATA
+2 MERGE BWDATA=^BWPCD(BWIEN)
+3 SET BWDFN=$$PC(0,2)
SET BWPT=$$PC(0,4)
SET BWFAC=$$PC(0,10)
SET BWDT=$$PC(0,12)
+4 SET BWPAP=BWPT=1
SET BWMAM="^25^26^28^"[(U_BWPT_U)
SET BWCBE=BWPT=27
+5 QUIT
+6 ; Return IEN of export format for default CDC version
CDCFMT() QUIT +$ORDER(^BWFMT("B","CDC"_$$CDCVER^BWMDEX2,0))
+1 ; Return data from specified node and piece
+2 ; BWN = Node subscript
+3 ; BWP = Data piece (defaults to 1)
+4 ; BWT = If specified and zero, forces null return value
PC(BWN,BWP,BWT) ; EP
+1 QUIT $SELECT($GET(BWT)=0:"",1:$PIECE($GET(BWDATA(BWN)),U,$GET(BWP,1)))
