- BDMD019 ; IHS/CMI/LAB - 2010 DIABETES AUDIT ; 21 Jan 2014 10:52 AM
- ;;2.0;DIABETES MANAGEMENT SYSTEM;**3,5,6,7,8,9,10**;JUN 14, 2007;Build 12
- ;
- ;
- W:$D(IOF) @IOF
- W !!,"Checking for Taxonomies to support the 2010 Audit. ",!,"Please enter the device for printing.",!
- ZIS ;
- S XBRC="",XBRP="TAXCHK^BDMD019",XBNS="",XBRX="XIT^BDMD019"
- D ^XBDBQUE
- D XIT
- Q
- TAXCHK ;EP - called by gui
- ;D HOME^%ZIS
- K BDMQUIT
- GUICHK ;EP
- NEW A,BDMX,I,Y,Z,J,BDMY,BDMT
- K A
- S BDMYR=$O(^BDMTAXS("B",2010,0))
- S BDMT=0 F S BDMT=$O(^BDMTAXS(BDMYR,11,BDMT)) Q:BDMT'=+BDMT D
- .S BDMY=$G(^BDMTAXS(BDMYR,11,BDMT,0))
- .S BDMTN=$P(BDMY,U,1)
- .S BDMFILE=$P(BDMY,U,2)
- .S BDMTYPE=$P(^DIC($P(BDMY,U,2),0),U)
- .S Y=BDMTYPE_" taxonomy "
- .I BDMFILE'=60 D
- ..I '$D(^ATXAX("B",BDMTN)) S A(BDMTN)=Y_"^is Missing" Q
- ..S I=$O(^ATXAX("B",BDMTN,0))
- ..I '$D(^ATXAX(I,21,"B")) S A(BDMTN)=Y_"^has no entries "
- .I BDMFILE=60 D
- ..I '$D(^ATXLAB("B",BDMTN)) S A(BDMTN)=Y_"^is Missing " Q
- ..S I=$O(^ATXLAB("B",BDMTN,0))
- ..I '$D(^ATXLAB(I,21,"B")) S A(BDMTN)=Y_"^has no entries "
- ..;check for panels and warn
- ..I '$P(^ATXLAB(I,0),U,11) D
- ...S BDMY=0 F S BDMY=$O(^ATXLAB(I,21,"B",BDMY)) Q:BDMY'=+BDMY D
- ....I $O(^LAB(60,BDMY,2,0)) S A(BDMTN)=Y_"^contains a panel test: "_$P(^LAB(60,BDMY,0),U)_" and should not."
- I '$D(A) W !,"All taxonomies are present.",! K A,BDMX,BDMT,BDMY,Y,I,Z D DONE Q
- W !!,"In order for the 2010 DM AUDIT Report to find all necessary data, several",!,"taxonomies must be established. The following taxonomies are missing or have",!,"no entries:"
- S BDMX="" F S BDMX=$O(A(BDMX)) Q:BDMX=""!($D(BDMQUIT)) D
- .;I $Y>(IOSL-2) D PAGE Q:$D(BDMQUIT)
- .W !,$P(A(BDMX),U)," [",BDMX,"] ",$P(A(BDMX),U,2)
- .Q
- DONE ;
- I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of taxonomy check. HIT RETURN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- Q
- XIT ;EP
- K BDM,BDMX,BDMQUIT,BDMLINE,BDMJ,BDMX,BDMTEXT,BDM
- K X,Y,J
- Q
- LASTHF(P,C,BDATE,EDATE,F) ;EP - get last factor in category C for patient P
- I '$G(P) Q ""
- I $G(C)="" Q ""
- I $G(F)="" S F=""
- S C=$O(^AUTTHF("B",C,0)) ;ien of category passed
- I '$G(C) Q ""
- NEW H,D,O S H=0 K O
- F S H=$O(^AUTTHF("AC",C,H)) Q:'+H D
- . Q:'$D(^AUPNVHF("AA",P,H))
- . S D="" F S D=$O(^AUPNVHF("AA",P,H,D)) Q:D'=+D D
- .. Q:(9999999-D)>EDATE ;after time frame
- .. Q:(9999999-D)<BDATE ;before time frame
- .. S O(D)=$O(^AUPNVHF("AA",P,H,D,""))
- . Q
- S D=$O(O(0))
- I D="" Q D
- I F="F" Q $P(^AUTTHF($P(^AUPNVHF(O(D),0),U),0),U)
- ;
- Q 1
- ;;
- BANNER ;EP - banner for 2010 audit menu
- S BDMTEXT="TEXTD",BDM("VERSION")="2.0 (Patch 10)"
- F BDMJ=1:1 S BDMX=$T(@BDMTEXT+BDMJ),BDMX=$P(BDMX,";;",2) Q:BDMX="QUIT"!(BDMX="") S BDMLINE=BDMJ
- PRINT D ^XBCLS W:$D(IOF) @IOF
- F BDMJ=1:1:BDMLINE S BDMX=$T(@BDMTEXT+BDMJ),BDMX=$P(BDMX,";;",2) W !?80-$L(BDMX)\2,BDMX K BDMX
- W !?80-(8+$L(BDM("VERSION")))/2,"Version ",BDM("VERSION")
- G XIT:'$D(DUZ(2)) G:'DUZ(2) XIT S BDM("SITE")=$P(^DIC(4,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),"^") W !!?80-$L(BDM("SITE"))\2,BDM("SITE")
- D XIT
- Q
- TEXTD ;EP
- ;;****************************************
- ;;** DIABETES MANAGEMENT SYSTEM **
- ;;** 2010 Diabetes Audit Report Menu **
- ;;****************************************
- ;;QUIT
- PAGE ;
- I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BDMQUIT="" Q
- Q
- BMIEPI(H,W) ;EP ;
- NEW %
- I H="" Q ""
- I W="" Q ""
- I 'H Q ""
- S W=W*.45359,H=(H*.0254),H=(H*H),%=(W/H),%=$J(%,4,1)
- Q %
- BDMD019 ; IHS/CMI/LAB - 2010 DIABETES AUDIT ; 21 Jan 2014 10:52 AM
- +1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**3,5,6,7,8,9,10**;JUN 14, 2007;Build 12
- +2 ;
- +3 ;
- +4 IF $DATA(IOF)
- WRITE @IOF
- +5 WRITE !!,"Checking for Taxonomies to support the 2010 Audit. ",!,"Please enter the device for printing.",!
- ZIS ;
- +1 SET XBRC=""
- SET XBRP="TAXCHK^BDMD019"
- SET XBNS=""
- SET XBRX="XIT^BDMD019"
- +2 DO ^XBDBQUE
- +3 DO XIT
- +4 QUIT
- TAXCHK ;EP - called by gui
- +1 ;D HOME^%ZIS
- +2 KILL BDMQUIT
- GUICHK ;EP
- +1 NEW A,BDMX,I,Y,Z,J,BDMY,BDMT
- +2 KILL A
- +3 SET BDMYR=$ORDER(^BDMTAXS("B",2010,0))
- +4 SET BDMT=0
- FOR
- SET BDMT=$ORDER(^BDMTAXS(BDMYR,11,BDMT))
- IF BDMT'=+BDMT
- QUIT
- Begin DoDot:1
- +5 SET BDMY=$GET(^BDMTAXS(BDMYR,11,BDMT,0))
- +6 SET BDMTN=$PIECE(BDMY,U,1)
- +7 SET BDMFILE=$PIECE(BDMY,U,2)
- +8 SET BDMTYPE=$PIECE(^DIC($PIECE(BDMY,U,2),0),U)
- +9 SET Y=BDMTYPE_" taxonomy "
- +10 IF BDMFILE'=60
- Begin DoDot:2
- +11 IF '$DATA(^ATXAX("B",BDMTN))
- SET A(BDMTN)=Y_"^is Missing"
- QUIT
- +12 SET I=$ORDER(^ATXAX("B",BDMTN,0))
- +13 IF '$DATA(^ATXAX(I,21,"B"))
- SET A(BDMTN)=Y_"^has no entries "
- End DoDot:2
- +14 IF BDMFILE=60
- Begin DoDot:2
- +15 IF '$DATA(^ATXLAB("B",BDMTN))
- SET A(BDMTN)=Y_"^is Missing "
- QUIT
- +16 SET I=$ORDER(^ATXLAB("B",BDMTN,0))
- +17 IF '$DATA(^ATXLAB(I,21,"B"))
- SET A(BDMTN)=Y_"^has no entries "
- +18 ;check for panels and warn
- +19 IF '$PIECE(^ATXLAB(I,0),U,11)
- Begin DoDot:3
- +20 SET BDMY=0
- FOR
- SET BDMY=$ORDER(^ATXLAB(I,21,"B",BDMY))
- IF BDMY'=+BDMY
- QUIT
- Begin DoDot:4
- +21 IF $ORDER(^LAB(60,BDMY,2,0))
- SET A(BDMTN)=Y_"^contains a panel test: "_$PIECE(^LAB(60,BDMY,0),U)_" and should not."
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +22 IF '$DATA(A)
- WRITE !,"All taxonomies are present.",!
- KILL A,BDMX,BDMT,BDMY,Y,I,Z
- DO DONE
- QUIT
- +23 WRITE !!,"In order for the 2010 DM AUDIT Report to find all necessary data, several",!,"taxonomies must be established. The following taxonomies are missing or have",!,"no entries:"
- +24 SET BDMX=""
- FOR
- SET BDMX=$ORDER(A(BDMX))
- IF BDMX=""!($DATA(BDMQUIT))
- QUIT
- Begin DoDot:1
- +25 ;I $Y>(IOSL-2) D PAGE Q:$D(BDMQUIT)
- +26 WRITE !,$PIECE(A(BDMX),U)," [",BDMX,"] ",$PIECE(A(BDMX),U,2)
- +27 QUIT
- End DoDot:1
- DONE ;
- +1 IF $EXTRACT(IOST)="C"
- IF IO=IO(0)
- SET DIR(0)="EO"
- SET DIR("A")="End of taxonomy check. HIT RETURN"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +2 QUIT
- XIT ;EP
- +1 KILL BDM,BDMX,BDMQUIT,BDMLINE,BDMJ,BDMX,BDMTEXT,BDM
- +2 KILL X,Y,J
- +3 QUIT
- LASTHF(P,C,BDATE,EDATE,F) ;EP - get last factor in category C for patient P
- +1 IF '$GET(P)
- QUIT ""
- +2 IF $GET(C)=""
- QUIT ""
- +3 IF $GET(F)=""
- SET F=""
- +4 ;ien of category passed
- SET C=$ORDER(^AUTTHF("B",C,0))
- +5 IF '$GET(C)
- QUIT ""
- +6 NEW H,D,O
- SET H=0
- KILL O
- +7 FOR
- SET H=$ORDER(^AUTTHF("AC",C,H))
- IF '+H
- QUIT
- Begin DoDot:1
- +8 IF '$DATA(^AUPNVHF("AA",P,H))
- QUIT
- +9 SET D=""
- FOR
- SET D=$ORDER(^AUPNVHF("AA",P,H,D))
- IF D'=+D
- QUIT
- Begin DoDot:2
- +10 ;after time frame
- IF (9999999-D)>EDATE
- QUIT
- +11 ;before time frame
- IF (9999999-D)<BDATE
- QUIT
- +12 SET O(D)=$ORDER(^AUPNVHF("AA",P,H,D,""))
- End DoDot:2
- +13 QUIT
- End DoDot:1
- +14 SET D=$ORDER(O(0))
- +15 IF D=""
- QUIT D
- +16 IF F="F"
- QUIT $PIECE(^AUTTHF($PIECE(^AUPNVHF(O(D),0),U),0),U)
- +17 ;
- +18 QUIT 1
- +19 ;;
- BANNER ;EP - banner for 2010 audit menu
- +1 SET BDMTEXT="TEXTD"
- SET BDM("VERSION")="2.0 (Patch 10)"
- +2 FOR BDMJ=1:1
- SET BDMX=$TEXT(@BDMTEXT+BDMJ)
- SET BDMX=$PIECE(BDMX,";;",2)
- IF BDMX="QUIT"!(BDMX="")
- QUIT
- SET BDMLINE=BDMJ
- PRINT DO ^XBCLS
- IF $DATA(IOF)
- WRITE @IOF
- +1 FOR BDMJ=1:1:BDMLINE
- SET BDMX=$TEXT(@BDMTEXT+BDMJ)
- SET BDMX=$PIECE(BDMX,";;",2)
- WRITE !?80-$LENGTH(BDMX)\2,BDMX
- KILL BDMX
- +2 WRITE !?80-(8+$LENGTH(BDM("VERSION")))/2,"Version ",BDM("VERSION")
- +3 IF '$DATA(DUZ(2))
- GOTO XIT
- IF 'DUZ(2)
- GOTO XIT
- SET BDM("SITE")=$PIECE(^DIC(4,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),"^")
- WRITE !!?80-$LENGTH(BDM("SITE"))\2,BDM("SITE")
- +4 DO XIT
- +5 QUIT
- TEXTD ;EP
- +1 ;;****************************************
- +2 ;;** DIABETES MANAGEMENT SYSTEM **
- +3 ;;** 2010 Diabetes Audit Report Menu **
- +4 ;;****************************************
- +5 ;;QUIT
- PAGE ;
- +1 IF $EXTRACT(IOST)="C"
- IF IO=IO(0)
- WRITE !
- SET DIR(0)="EO"
- DO ^DIR
- KILL DIR
- IF Y=0!(Y="^")!($DATA(DTOUT))
- SET BDMQUIT=""
- QUIT
- +2 QUIT
- BMIEPI(H,W) ;EP ;
- +1 NEW %
- +2 IF H=""
- QUIT ""
- +3 IF W=""
- QUIT ""
- +4 IF 'H
- QUIT ""
- +5 SET W=W*.45359
- SET H=(H*.0254)
- SET H=(H*H)
- SET %=(W/H)
- SET %=$JUSTIFY(%,4,1)
- +6 QUIT %
