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

BWMDEX.m

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