BDMDA1B ; IHS/CMI/LAB - get dm audit values ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**6**;JUN 14, 2007;Build 6
;
TD(P,EDATE) ;EP
NEW BDM,X,E,B,%DT,Y,TDD,D,LTD,G,C,Z,T
K TDD
S %DT="P",X=EDATE D ^%DT S E=Y ;set E = ending date in fm format
S B=$$FMADD^XLFDT(E,-3653) ;b is 10 years back from end date in fm format
D LASTTDN ;get td from v imm
S LTD=$O(TDD(0))
I LTD]"" S LTD=9999999-LTD
;now check cpt codes
S T=$O(^ATXAX("B","DM AUDIT TD CPTS",0))
K C I T S C=$$CPT^BDMDA12(P,B,E,T,3) D
.I C="" Q
.Q:LTD>$P(C,U)
.S LTD=$P(C,U)
I LTD]"" Q "1 Yes "_$$FMTE^XLFDT(LTD)
S C=$$FMTE^XLFDT(B) ;external form of beginning date
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",$S($$BI:9,1:"02"),0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",$S($$BI:1,1:"03"),0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",$S($$BI:28,1:34),0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",$S($$BI:20,1:42),0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",$S($$BI:35,1:04),0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
I '$$BI Q "2 No"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",22,0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",50,0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",106,0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",107,0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",110,0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",113,0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",115,0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",120,0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",130,0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",132,0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",138,0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",139,0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
S G=$$REFUSAL^BDMDA17(P,9999999.14,$O(^AUTTIMM("C",142,0)),C,EDATE)
I G,$P(G,U,2)'="N" Q "3 Refused"
I G Q "2 No - Not Medically Indicated"
TDBI ;
S G="" F Z=1,9,20,22,28,35,50,106,107,110,112,113,115,120,130,132,138,139,142 Q:G S X=0,Y=$O(^AUTTIMM("C",Z,0)) I Y F S X=$O(^BIPC("AC",P,Y,X)) Q:X'=+X!(G) D
.S R=$P(^BIPC(X,0),U,3)
.Q:R=""
.Q:'$D(^BICONT(R,0))
.Q:$P(^BICONT(R,0),U,1)'["Refusal"
.S D=$P(^BIPC(X,0),U,4)
.Q:D=""
.Q:D<B
.Q:D>E
.S G=1_U_D
I G Q "3 Refused (Immunization package) "_$$FMTE^XLFDT($P(D,U,2))
Q "2 No"
;
LASTTDN ;
S X=0 F S X=$O(^AUPNVIMM("AC",P,X)) Q:X'=+X D
.S Y=$P(^AUPNVIMM(X,0),U) Q:'Y
.Q:'$D(^AUTTIMM(Y,0))
.S Y=$P(^AUTTIMM(Y,0),U,3)
.S D=$P(^AUPNVIMM(X,0),U,3) Q:'D
.S D=$P($P($G(^AUPNVSIT(D,0)),U),".")
.I D<B Q ;too early
.I D>E Q ;after time frame
.I Y=1 S TDD(9999999-D)="" Q
.I Y=9 S TDD(9999999-D)="" Q
.I Y=20 S TDD(9999999-D)="" Q
.I Y=22 S TDD(9999999-D)="" Q
.I Y=28 S TDD(9999999-D)="" Q
.I Y=35 S TDD(9999999-D)="" Q
.I Y=50 S TDD(9999999-D)="" Q
.I Y=106 S TDD(9999999-D)="" Q
.I Y=107 S TDD(9999999-D)="" Q
.I Y=110 S TDD(9999999-D)="" Q
.I Y=112 S TDD(9999999-D)="" Q
.I Y=113 S TDD(9999999-D)="" Q
.I Y=115 S TDD(9999999-D)="" Q
.I Y=120 S TDD(9999999-D)="" Q
.I Y=130 S TDD(9999999-D)="" Q
.I Y=132 S TDD(9999999-D)="" Q
.I Y=138 S TDD(9999999-D)="" Q
.I Y=139 S TDD(9999999-D)="" Q
.I Y=142 S TDD(9999999-D)="" Q
Q
BI() ;
Q $S($O(^AUTTIMM(0))>100:1,1:0)
BDMDA1B ; IHS/CMI/LAB - get dm audit values ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**6**;JUN 14, 2007;Build 6
+2 ;
TD(P,EDATE) ;EP
+1 NEW BDM,X,E,B,%DT,Y,TDD,D,LTD,G,C,Z,T
+2 KILL TDD
+3 ;set E = ending date in fm format
SET %DT="P"
SET X=EDATE
DO ^%DT
SET E=Y
+4 ;b is 10 years back from end date in fm format
SET B=$$FMADD^XLFDT(E,-3653)
+5 ;get td from v imm
DO LASTTDN
+6 SET LTD=$ORDER(TDD(0))
+7 IF LTD]""
SET LTD=9999999-LTD
+8 ;now check cpt codes
+9 SET T=$ORDER(^ATXAX("B","DM AUDIT TD CPTS",0))
+10 KILL C
IF T
SET C=$$CPT^BDMDA12(P,B,E,T,3)
Begin DoDot:1
+11 IF C=""
QUIT
+12 IF LTD>$PIECE(C,U)
QUIT
+13 SET LTD=$PIECE(C,U)
End DoDot:1
+14 IF LTD]""
QUIT "1 Yes "_$$FMTE^XLFDT(LTD)
+15 ;external form of beginning date
SET C=$$FMTE^XLFDT(B)
+16 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",$SELECT($$BI:9,1:"02"),0)),C,EDATE)
+17 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+18 IF G
QUIT "2 No - Not Medically Indicated"
+19 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",$SELECT($$BI:1,1:"03"),0)),C,EDATE)
+20 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+21 IF G
QUIT "2 No - Not Medically Indicated"
+22 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",$SELECT($$BI:28,1:34),0)),C,EDATE)
+23 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+24 IF G
QUIT "2 No - Not Medically Indicated"
+25 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",$SELECT($$BI:20,1:42),0)),C,EDATE)
+26 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+27 IF G
QUIT "2 No - Not Medically Indicated"
+28 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",$SELECT($$BI:35,1:04),0)),C,EDATE)
+29 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+30 IF G
QUIT "2 No - Not Medically Indicated"
+31 IF '$$BI
QUIT "2 No"
+32 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",22,0)),C,EDATE)
+33 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+34 IF G
QUIT "2 No - Not Medically Indicated"
+35 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",50,0)),C,EDATE)
+36 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+37 IF G
QUIT "2 No - Not Medically Indicated"
+38 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",106,0)),C,EDATE)
+39 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+40 IF G
QUIT "2 No - Not Medically Indicated"
+41 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",107,0)),C,EDATE)
+42 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+43 IF G
QUIT "2 No - Not Medically Indicated"
+44 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",110,0)),C,EDATE)
+45 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+46 IF G
QUIT "2 No - Not Medically Indicated"
+47 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",113,0)),C,EDATE)
+48 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+49 IF G
QUIT "2 No - Not Medically Indicated"
+50 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",115,0)),C,EDATE)
+51 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+52 IF G
QUIT "2 No - Not Medically Indicated"
+53 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",120,0)),C,EDATE)
+54 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+55 IF G
QUIT "2 No - Not Medically Indicated"
+56 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",130,0)),C,EDATE)
+57 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+58 IF G
QUIT "2 No - Not Medically Indicated"
+59 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",132,0)),C,EDATE)
+60 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+61 IF G
QUIT "2 No - Not Medically Indicated"
+62 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",138,0)),C,EDATE)
+63 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+64 IF G
QUIT "2 No - Not Medically Indicated"
+65 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",139,0)),C,EDATE)
+66 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+67 IF G
QUIT "2 No - Not Medically Indicated"
+68 SET G=$$REFUSAL^BDMDA17(P,9999999.14,$ORDER(^AUTTIMM("C",142,0)),C,EDATE)
+69 IF G
IF $PIECE(G,U,2)'="N"
QUIT "3 Refused"
+70 IF G
QUIT "2 No - Not Medically Indicated"
TDBI ;
+1 SET G=""
FOR Z=1,9,20,22,28,35,50,106,107,110,112,113,115,120,130,132,138,139,142
IF G
QUIT
SET X=0
SET Y=$ORDER(^AUTTIMM("C",Z,0))
IF Y
FOR
SET X=$ORDER(^BIPC("AC",P,Y,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+2 SET R=$PIECE(^BIPC(X,0),U,3)
+3 IF R=""
QUIT
+4 IF '$DATA(^BICONT(R,0))
QUIT
+5 IF $PIECE(^BICONT(R,0),U,1)'["Refusal"
QUIT
+6 SET D=$PIECE(^BIPC(X,0),U,4)
+7 IF D=""
QUIT
+8 IF D<B
QUIT
+9 IF D>E
QUIT
+10 SET G=1_U_D
End DoDot:1
+11 IF G
QUIT "3 Refused (Immunization package) "_$$FMTE^XLFDT($PIECE(D,U,2))
+12 QUIT "2 No"
+13 ;
LASTTDN ;
+1 SET X=0
FOR
SET X=$ORDER(^AUPNVIMM("AC",P,X))
IF X'=+X
QUIT
Begin DoDot:1
+2 SET Y=$PIECE(^AUPNVIMM(X,0),U)
IF 'Y
QUIT
+3 IF '$DATA(^AUTTIMM(Y,0))
QUIT
+4 SET Y=$PIECE(^AUTTIMM(Y,0),U,3)
+5 SET D=$PIECE(^AUPNVIMM(X,0),U,3)
IF 'D
QUIT
+6 SET D=$PIECE($PIECE($GET(^AUPNVSIT(D,0)),U),".")
+7 ;too early
IF D<B
QUIT
+8 ;after time frame
IF D>E
QUIT
+9 IF Y=1
SET TDD(9999999-D)=""
QUIT
+10 IF Y=9
SET TDD(9999999-D)=""
QUIT
+11 IF Y=20
SET TDD(9999999-D)=""
QUIT
+12 IF Y=22
SET TDD(9999999-D)=""
QUIT
+13 IF Y=28
SET TDD(9999999-D)=""
QUIT
+14 IF Y=35
SET TDD(9999999-D)=""
QUIT
+15 IF Y=50
SET TDD(9999999-D)=""
QUIT
+16 IF Y=106
SET TDD(9999999-D)=""
QUIT
+17 IF Y=107
SET TDD(9999999-D)=""
QUIT
+18 IF Y=110
SET TDD(9999999-D)=""
QUIT
+19 IF Y=112
SET TDD(9999999-D)=""
QUIT
+20 IF Y=113
SET TDD(9999999-D)=""
QUIT
+21 IF Y=115
SET TDD(9999999-D)=""
QUIT
+22 IF Y=120
SET TDD(9999999-D)=""
QUIT
+23 IF Y=130
SET TDD(9999999-D)=""
QUIT
+24 IF Y=132
SET TDD(9999999-D)=""
QUIT
+25 IF Y=138
SET TDD(9999999-D)=""
QUIT
+26 IF Y=139
SET TDD(9999999-D)=""
QUIT
+27 IF Y=142
SET TDD(9999999-D)=""
QUIT
End DoDot:1
+28 QUIT
BI() ;
+1 QUIT $SELECT($ORDER(^AUTTIMM(0))>100:1,1:0)
