BWMDEX0 ;IHS/CIA/DKM - Export filters;25-Feb-2011 14:23;PLS
;;2.0;WOMEN'S HEALTH;**9,11,12**;MAY 16, 1996
;
; Generic screen for multi-valued list.
; BWVAL = Value to screen (or array of values)
; Return= Nonzero if meets inclusion criteria.
SCREEN(BWVAL) ;
Q:$D(BWFLT(BWFLT,"V"))<10 1
S:$L($G(BWVAL)) BWVAL(BWVAL)=""
S BWVAL=""
F S BWVAL=$O(BWVAL(BWVAL)) Q:'$L(BWVAL) Q:$D(BWFLT(BWFLT,"V",BWVAL))
Q $L(BWVAL)
; Generic prompt logic for file selection.
;
PROMPT(BWPMT,BWFN,BWDFL,BWSET) ;
D SELECT^BWUTLP($S(BWFLT(BWFLT,"N"):"-",1:"")_BWPMT,BWFN,$NA(BWFLT(BWFLT,"V")),"",$G(BWDFL),.BWPOP,.BWSET,0)
Q
; Generic display logic for multi-valued list.
DISPLAY(BWLBL,BWFN,BWSET) ;
N BWLP,BWDLM,X
S BWLP=0,BWDLM=BWLBL_": "
F S BWLP=$O(BWFLT(BWFLT,"V",BWLP)) Q:'BWLP D
.I $G(BWSET) S X=$$LOW^XLFSTR($$EXTERNAL^DILFD(BWFN,BWSET,,BWLP))
.E S X=$$GET1^DIQ(BWFN,BWLP,.01)
.W BWDLM
.W:$X+$L(X)'<$G(IOM,80) !?5
.W X
.S BWDLM="; "
I BWDLM="; " W ".",!
E W "ALL "_BWLBL_".",!
Q
; Screen by age range
AGESCRN() ;
N BWAGE,BWDOD
S BWDOD=+$$DOD^AUPNPAT(BWDFN)
S BWAGE=+$$AGEAT^BWUTL1(BWDFN,$S(BWDOD:BWDOD,1:DT))
Q $S(BWAGE<$O(BWFLT(BWFLT,"V",0)):0,BWAGE>$O(BWFLT(BWFLT,"V",""),-1):0,1:1)
; Prompt for age range
AGEPMPT N BWAGE,BWHLP,BWLOW,BWHIGH
W "Enter age range for this export.",!
F BWAGE="1:99:18","1:99:64" D Q:BWPOP
.S BWLOW=$P(BWAGE,":"),BWHIGH=$P(BWAGE,":",2),BWDEF=$P(BWAGE,":",3)
.S BWHLP=" Procedures for patients "_$S(BWLOW=18:"under",1:"over")_" this age will NOT be exported."
.S BWAGE=$$DIR^BWUTLP("N^"_BWLOW_":"_BWHIGH," Enter an age ("_BWLOW_"-"_BWHIGH_")",BWDEF,BWHLP,.BWPOP)
.S:'BWPOP BWFLT(BWFLT,"V",BWAGE)=""
Q
; Display age range
AGEDSPL W "ages ",$O(BWFLT(BWFLT,"V",0))," to ",$O(BWFLT(BWFLT,"V",""),-1),", inclusive.",!
Q
; Screen by date range
DATSCRN() ;
Q $S(BWDT<$O(BWFLT(BWFLT,"V",0)):0,BWDT>$O(BWFLT(BWFLT,"V",""),-1):0,1:1)
; Prompt for date range
DATPMPT N BWSTTDT,BWDT1,BWDT2
S BWSTTDT=$P(^BWSITE(DUZ(2),0),U,17)
D SHOWDLG^BWUTLP(9)
F D ASKDATES^BWUTLP(.BWDT1,.BWDT2,.BWPOP,BWSTTDT) Q:BWPOP Q:BWDT1'<BWSTTDT D
.D SHOWDLG^BWUTLP(10)
S:'BWPOP BWFLT(BWFLT,"V",BWDT1)="",BWFLT(BWFLT,"V",BWDT2)=""
Q
; Display date range
DATDSPL W "procedures from ",$$FMTE^XLFDT($O(BWFLT(BWFLT,"V",0)))," to ",$$FMTE^XLFDT($O(BWFLT(BWFLT,"V",""),-1)),", inclusive.",!
Q
; Screen CDC procedures
CDCSCRN() ;
Q:BWPT=1!(BWPT=28) 1
I BWPT=25!(BWPT=26),$$PC^BWMDEX(2,32) Q 1
I BWPT=27,$$PC^BWMDEX(2,39),$$CBE^BWMDEX2=1 Q 1
Q 0
; Evaluate Medicare Eligibility
MCARE(BWDT,BWSC) ;
Q $$MELIG("^AUPNMCR",BWDT,.BWSC)
; Evaluate Medicaid Elibibility
MCAID(BWDT,BWSC) ;
Q $$MELIG("^AUPNMCD",BWDT,.BWSC)
; Returns true if eligible for Medicare/Medicaid on date given.
MELIG(BWGL,BWDT,BWSC) ;
N S,X,Y,Z
S (X,Z)=0,BWSC=$G(BWSC)
F S X=$O(@BWGL@(BWDFN,11,X)) Q:'X!Z S Y=$G(^(X,0)) D
.S S=$P(Y,U,3)
.I $L(BWSC),'$L(S)!(BWSC'[S) Q
.Q:BWDT<Y
.S Y=$P(Y,U,2)
.Q:Y&(BWDT'<Y)
.S Z=1
Q Z
; Return Income exclusion flag
INCCHK(BWDFN,BWDT) ;
; Input: BWDT - Date of procedure
; Returns: 0=exclude procedure; 1=include procedure
N ELGV,ELGDT
Q:'$G(BWDFN)!'$G(BWDT) 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)&(BWDT'<ELGDT):0,1:1)
; Returns true if patient had private insurance on given date
HASPI(BWDFN,BWDT) ;
Q $$PI^BWGRVLU(BWDFN,BWDT)
PAPELG(BWDFN) ;
N PAPELG
S PAPELG=$$GET1^DIQ(9002086,BWDFN,.32,"I")
Q $S(PAPELG=1:1,1:0)
MAMELG(BWDFN) ;
N MAMELG
S MAMELG=$$GET1^DIQ(9002086,BWDFN,.33,"I")
Q $S(MAMELG=1:1,1:0)
Q
BWMDEX0 ;IHS/CIA/DKM - Export filters;25-Feb-2011 14:23;PLS
+1 ;;2.0;WOMEN'S HEALTH;**9,11,12**;MAY 16, 1996
+2 ;
+3 ; Generic screen for multi-valued list.
+4 ; BWVAL = Value to screen (or array of values)
+5 ; Return= Nonzero if meets inclusion criteria.
SCREEN(BWVAL) ;
+1 IF $DATA(BWFLT(BWFLT,"V"))<10
QUIT 1
+2 IF $LENGTH($GET(BWVAL))
SET BWVAL(BWVAL)=""
+3 SET BWVAL=""
+4 FOR
SET BWVAL=$ORDER(BWVAL(BWVAL))
IF '$LENGTH(BWVAL)
QUIT
IF $DATA(BWFLT(BWFLT,"V",BWVAL))
QUIT
+5 QUIT $LENGTH(BWVAL)
+6 ; Generic prompt logic for file selection.
+7 ;
PROMPT(BWPMT,BWFN,BWDFL,BWSET) ;
+1 DO SELECT^BWUTLP($SELECT(BWFLT(BWFLT,"N"):"-",1:"")_BWPMT,BWFN,$NAME(BWFLT(BWFLT,"V")),"",$GET(BWDFL),.BWPOP,.BWSET,0)
+2 QUIT
+3 ; Generic display logic for multi-valued list.
DISPLAY(BWLBL,BWFN,BWSET) ;
+1 NEW BWLP,BWDLM,X
+2 SET BWLP=0
SET BWDLM=BWLBL_": "
+3 FOR
SET BWLP=$ORDER(BWFLT(BWFLT,"V",BWLP))
IF 'BWLP
QUIT
Begin DoDot:1
+4 IF $GET(BWSET)
SET X=$$LOW^XLFSTR($$EXTERNAL^DILFD(BWFN,BWSET,,BWLP))
+5 IF '$TEST
SET X=$$GET1^DIQ(BWFN,BWLP,.01)
+6 WRITE BWDLM
+7 IF $X+$LENGTH(X)'<$GET(IOM,80)
WRITE !?5
+8 WRITE X
+9 SET BWDLM="; "
End DoDot:1
+10 IF BWDLM="; "
WRITE ".",!
+11 IF '$TEST
WRITE "ALL "_BWLBL_".",!
+12 QUIT
+13 ; Screen by age range
AGESCRN() ;
+1 NEW BWAGE,BWDOD
+2 SET BWDOD=+$$DOD^AUPNPAT(BWDFN)
+3 SET BWAGE=+$$AGEAT^BWUTL1(BWDFN,$SELECT(BWDOD:BWDOD,1:DT))
+4 QUIT $SELECT(BWAGE<$ORDER(BWFLT(BWFLT,"V",0)):0,BWAGE>$ORDER(BWFLT(BWFLT,"V",""),-1):0,1:1)
+5 ; Prompt for age range
AGEPMPT NEW BWAGE,BWHLP,BWLOW,BWHIGH
+1 WRITE "Enter age range for this export.",!
+2 FOR BWAGE="1:99:18","1:99:64"
Begin DoDot:1
+3 SET BWLOW=$PIECE(BWAGE,":")
SET BWHIGH=$PIECE(BWAGE,":",2)
SET BWDEF=$PIECE(BWAGE,":",3)
+4 SET BWHLP=" Procedures for patients "_$SELECT(BWLOW=18:"under",1:"over")_" this age will NOT be exported."
+5 SET BWAGE=$$DIR^BWUTLP("N^"_BWLOW_":"_BWHIGH," Enter an age ("_BWLOW_"-"_BWHIGH_")",BWDEF,BWHLP,.BWPOP)
+6 IF 'BWPOP
SET BWFLT(BWFLT,"V",BWAGE)=""
End DoDot:1
IF BWPOP
QUIT
+7 QUIT
+8 ; Display age range
AGEDSPL WRITE "ages ",$ORDER(BWFLT(BWFLT,"V",0))," to ",$ORDER(BWFLT(BWFLT,"V",""),-1),", inclusive.",!
+1 QUIT
+2 ; Screen by date range
DATSCRN() ;
+1 QUIT $SELECT(BWDT<$ORDER(BWFLT(BWFLT,"V",0)):0,BWDT>$ORDER(BWFLT(BWFLT,"V",""),-1):0,1:1)
+2 ; Prompt for date range
DATPMPT NEW BWSTTDT,BWDT1,BWDT2
+1 SET BWSTTDT=$PIECE(^BWSITE(DUZ(2),0),U,17)
+2 DO SHOWDLG^BWUTLP(9)
+3 FOR
DO ASKDATES^BWUTLP(.BWDT1,.BWDT2,.BWPOP,BWSTTDT)
IF BWPOP
QUIT
IF BWDT1'<BWSTTDT
QUIT
Begin DoDot:1
+4 DO SHOWDLG^BWUTLP(10)
End DoDot:1
+5 IF 'BWPOP
SET BWFLT(BWFLT,"V",BWDT1)=""
SET BWFLT(BWFLT,"V",BWDT2)=""
+6 QUIT
+7 ; Display date range
DATDSPL WRITE "procedures from ",$$FMTE^XLFDT($ORDER(BWFLT(BWFLT,"V",0)))," to ",$$FMTE^XLFDT($ORDER(BWFLT(BWFLT,"V",""),-1)),", inclusive.",!
+1 QUIT
+2 ; Screen CDC procedures
CDCSCRN() ;
+1 IF BWPT=1!(BWPT=28)
QUIT 1
+2 IF BWPT=25!(BWPT=26)
IF $$PC^BWMDEX(2,32)
QUIT 1
+3 IF BWPT=27
IF $$PC^BWMDEX(2,39)
IF $$CBE^BWMDEX2=1
QUIT 1
+4 QUIT 0
+5 ; Evaluate Medicare Eligibility
MCARE(BWDT,BWSC) ;
+1 QUIT $$MELIG("^AUPNMCR",BWDT,.BWSC)
+2 ; Evaluate Medicaid Elibibility
MCAID(BWDT,BWSC) ;
+1 QUIT $$MELIG("^AUPNMCD",BWDT,.BWSC)
+2 ; Returns true if eligible for Medicare/Medicaid on date given.
MELIG(BWGL,BWDT,BWSC) ;
+1 NEW S,X,Y,Z
+2 SET (X,Z)=0
SET BWSC=$GET(BWSC)
+3 FOR
SET X=$ORDER(@BWGL@(BWDFN,11,X))
IF 'X!Z
QUIT
SET Y=$GET(^(X,0))
Begin DoDot:1
+4 SET S=$PIECE(Y,U,3)
+5 IF $LENGTH(BWSC)
IF '$LENGTH(S)!(BWSC'[S)
QUIT
+6 IF BWDT<Y
QUIT
+7 SET Y=$PIECE(Y,U,2)
+8 IF Y&(BWDT'<Y)
QUIT
+9 SET Z=1
End DoDot:1
+10 QUIT Z
+11 ; Return Income exclusion flag
INCCHK(BWDFN,BWDT) ;
+1 ; Input: BWDT - Date of procedure
+2 ; Returns: 0=exclude procedure; 1=include procedure
+3 NEW ELGV,ELGDT
+4 ; include procedure by default
IF '$GET(BWDFN)!'$GET(BWDT)
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)&(BWDT'<ELGDT):0,1:1)
+9 ; Returns true if patient had private insurance on given date
HASPI(BWDFN,BWDT) ;
+1 QUIT $$PI^BWGRVLU(BWDFN,BWDT)
PAPELG(BWDFN) ;
+1 NEW PAPELG
+2 SET PAPELG=$$GET1^DIQ(9002086,BWDFN,.32,"I")
+3 QUIT $SELECT(PAPELG=1:1,1:0)
MAMELG(BWDFN) ;
+1 NEW MAMELG
+2 SET MAMELG=$$GET1^DIQ(9002086,BWDFN,.33,"I")
+3 QUIT $SELECT(MAMELG=1:1,1:0)
+4 QUIT
