BDMP9 ; IHS/CMI/LAB - post init to patch 8 ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
;
D ^BDMBUL
S ATXX=$O(^ATXAX("B","BDM DIABETES REG NEW CASE",0)) I ATXX D ZTM^ATXAX
S ATXX=$O(^ATXAX("B","BDM DIABETES REG COMPLICATION",0)) I ATXX D ZTM^ATXAX
;add new report to menu
NEW X
S X=$$ADD^XPDMENU("BDM M DX/PROC COUNT REPORTS","BDM P RX RELEASE","RXDA")
I 'X W "Attempt to add RX Data Analysis Report option failed." H 3
S X=$$ADD^XPDMENU("BDM M MAN QUALITY ASSURANCE","BDMBP IN/OUT CONTROL BPS","BPC")
I 'X W "Attempt to add RX Data Analysis Report option failed." H 3
S X=$$ADD^XPDMENU("BDM M MAIN DM MENU","BDM DM PTS NO DX PL","PLDX")
I 'X W "Attempt to add Patients w/o DM option failed.." H 3
S X=$$ADD^XPDMENU("BDM M MAIN DM MENU","BDM DM2000 AUDIT MENU","DM20")
I 'X W "Attempt to add DM 2000 Audit Menu option failed.." H 3
S X=$$ADD^XPDMENU("BDM M MAIN DM MENU","BDM TAXONOMY SETUP","TS")
I 'X W "Attempt to add Taxonomy Setup menu option failed.." H 3
S X=$$ADD^XPDMENU("BDM M MAIN DM MENU","BDM FLOW SHEET SETUP","FS")
I 'X W "Attempt to add Flow Sheet Setup Menu option failed.." H 3
S X=$$ADD^XPDMENU("BDM M MAN PATIENT LISTINGS","BDM P ELDER CARE 1","ELFA")
I 'X W "Attempt to add Elder Care Report 1 option failed." H 3
S X=$$ADD^XPDMENU("BDM M MAN PATIENT LISTINGS","BDM P ELDER CARE 2","ELFC")
I 'X W "Attempt to add Elder Care Report 2 option failed." H 3
S X=$$ADD^XPDMENU("BDM M MAN PATIENT LISTINGS","BDM P ELDER CARE 3","ELFT")
I 'X W "Attempt to add Elder Care Report 3 option failed." H 3
;set up HDL taxonomy
TAXS ;
S ATXFLG=1
D LAB
D DRUGS
D DMEDUC
K ATXFLG,ATXX,BDMX,BDMDA,BDMTX
Q
LAB ;
S BDMX="DM AUDIT HDL TAX" D LAB1
Q
LAB1 ;
W !,"Creating ",BDMX," Taxonomy..."
S BDMDA=$O(^ATXLAB("B",BDMX,0))
Q:BDMDA ;taxonomy already exisits
S X=BDMX,DIC="^ATXLAB(",DIC(0)="L",DIADD=1,DLAYGO=9002228 D ^DIC K DIC,DA,DIADD,DLAYGO,I
I Y=-1 W !!,"ERROR IN CREATING ",BDMX," TAX" Q
S BDMTX=+Y,$P(^ATXLAB(BDMTX,0),U,2)=BDMX,$P(^(0),U,5)=DUZ,$P(^(0),U,6)=DT,$P(^(0),U,8)="B",$P(^(0),U,9)=60,^ATXLAB(BDMTX,21,0)="^9002228.02101PA^0^0"
S DA=BDMTX,DIK="^ATXAX(" D IX1^DIK
Q
DRUGS ;set up drug taxonomies
S BDMX="DM AUDIT LIPID LOWERING DRUGS" D DRUG1
Q
DRUG1 ;
W !,"Creating ",BDMX," Taxonomy..."
S BDMDA=$O(^ATXAX("B",BDMX,0))
Q:BDMDA ;taxonomy already exisits
S X=BDMX,DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
I Y=-1 W !!,"ERROR IN CREATING ",BDMX," TAX" Q
S BDMTX=+Y,$P(^ATXAX(BDMTX,0),U,2)=BDMX,$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=173,$P(^(0),U,13)=0,$P(^(0),U,15)=50,^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
S DA=BDMTX,DIK="^ATXAX(" D IX1^DIK
Q
DMEDUC ;
W !,"Creating Education topics taxonomy..."
S BDMDA=0 S BDMDA=$O(^ATXAX("B","DM AUDIT SMOKING CESS EDUC",BDMDA)) I 'BDMDA D
.S X="DM AUDIT SMOKING CESS EDUC",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
.I Y=-1 W !!,"ERROR IN CREATING DM AUDIT SMOKING CESS EDUC TAX" Q
.S BDMTX=+Y,$P(^ATXAX(BDMTX,0),U,2)="DM AUDIT SMOKING CESS EDUC",$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=280,$P(^(0),U,13)=0,$P(^(0),U,15)=9999999.09,^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
.S ^ATXAX(BDMTX,21,BDMX,0)=+Y,$P(^ATXAX(BDMTX,21,0),U,3)=BDMX,$P(^(0),U,4)=BDMX,^ATXAX(BDMTX,21,"AA",+Y,+Y)=""
.S DA=BDMTX,DIK="^ATXAX(" D IX1^DIK
Q
BDMP9 ; IHS/CMI/LAB - post init to patch 8 ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
+2 ;
+3 DO ^BDMBUL
+4 SET ATXX=$ORDER(^ATXAX("B","BDM DIABETES REG NEW CASE",0))
IF ATXX
DO ZTM^ATXAX
+5 SET ATXX=$ORDER(^ATXAX("B","BDM DIABETES REG COMPLICATION",0))
IF ATXX
DO ZTM^ATXAX
+6 ;add new report to menu
+7 NEW X
+8 SET X=$$ADD^XPDMENU("BDM M DX/PROC COUNT REPORTS","BDM P RX RELEASE","RXDA")
+9 IF 'X
WRITE "Attempt to add RX Data Analysis Report option failed."
HANG 3
+10 SET X=$$ADD^XPDMENU("BDM M MAN QUALITY ASSURANCE","BDMBP IN/OUT CONTROL BPS","BPC")
+11 IF 'X
WRITE "Attempt to add RX Data Analysis Report option failed."
HANG 3
+12 SET X=$$ADD^XPDMENU("BDM M MAIN DM MENU","BDM DM PTS NO DX PL","PLDX")
+13 IF 'X
WRITE "Attempt to add Patients w/o DM option failed.."
HANG 3
+14 SET X=$$ADD^XPDMENU("BDM M MAIN DM MENU","BDM DM2000 AUDIT MENU","DM20")
+15 IF 'X
WRITE "Attempt to add DM 2000 Audit Menu option failed.."
HANG 3
+16 SET X=$$ADD^XPDMENU("BDM M MAIN DM MENU","BDM TAXONOMY SETUP","TS")
+17 IF 'X
WRITE "Attempt to add Taxonomy Setup menu option failed.."
HANG 3
+18 SET X=$$ADD^XPDMENU("BDM M MAIN DM MENU","BDM FLOW SHEET SETUP","FS")
+19 IF 'X
WRITE "Attempt to add Flow Sheet Setup Menu option failed.."
HANG 3
+20 SET X=$$ADD^XPDMENU("BDM M MAN PATIENT LISTINGS","BDM P ELDER CARE 1","ELFA")
+21 IF 'X
WRITE "Attempt to add Elder Care Report 1 option failed."
HANG 3
+22 SET X=$$ADD^XPDMENU("BDM M MAN PATIENT LISTINGS","BDM P ELDER CARE 2","ELFC")
+23 IF 'X
WRITE "Attempt to add Elder Care Report 2 option failed."
HANG 3
+24 SET X=$$ADD^XPDMENU("BDM M MAN PATIENT LISTINGS","BDM P ELDER CARE 3","ELFT")
+25 IF 'X
WRITE "Attempt to add Elder Care Report 3 option failed."
HANG 3
+26 ;set up HDL taxonomy
TAXS ;
+1 SET ATXFLG=1
+2 DO LAB
+3 DO DRUGS
+4 DO DMEDUC
+5 KILL ATXFLG,ATXX,BDMX,BDMDA,BDMTX
+6 QUIT
LAB ;
+1 SET BDMX="DM AUDIT HDL TAX"
DO LAB1
+2 QUIT
LAB1 ;
+1 WRITE !,"Creating ",BDMX," Taxonomy..."
+2 SET BDMDA=$ORDER(^ATXLAB("B",BDMX,0))
+3 ;taxonomy already exisits
IF BDMDA
QUIT
+4 SET X=BDMX
SET DIC="^ATXLAB("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002228
DO ^DIC
KILL DIC,DA,DIADD,DLAYGO,I
+5 IF Y=-1
WRITE !!,"ERROR IN CREATING ",BDMX," TAX"
QUIT
+6 SET BDMTX=+Y
SET $PIECE(^ATXLAB(BDMTX,0),U,2)=BDMX
SET $PIECE(^(0),U,5)=DUZ
SET $PIECE(^(0),U,6)=DT
SET $PIECE(^(0),U,8)="B"
SET $PIECE(^(0),U,9)=60
SET ^ATXLAB(BDMTX,21,0)="^9002228.02101PA^0^0"
+7 SET DA=BDMTX
SET DIK="^ATXAX("
DO IX1^DIK
+8 QUIT
DRUGS ;set up drug taxonomies
+1 SET BDMX="DM AUDIT LIPID LOWERING DRUGS"
DO DRUG1
+2 QUIT
DRUG1 ;
+1 WRITE !,"Creating ",BDMX," Taxonomy..."
+2 SET BDMDA=$ORDER(^ATXAX("B",BDMX,0))
+3 ;taxonomy already exisits
IF BDMDA
QUIT
+4 SET X=BDMX
SET DIC="^ATXAX("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002226
DO ^DIC
KILL DIC,DA,DIADD,DLAYGO,I
+5 IF Y=-1
WRITE !!,"ERROR IN CREATING ",BDMX," TAX"
QUIT
+6 SET BDMTX=+Y
SET $PIECE(^ATXAX(BDMTX,0),U,2)=BDMX
SET $PIECE(^(0),U,5)=DUZ
SET $PIECE(^(0),U,8)=0
SET $PIECE(^(0),U,9)=DT
SET $PIECE(^(0),U,12)=173
SET $PIECE(^(0),U,13)=0
SET $PIECE(^(0),U,15)=50
SET ^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
+7 SET DA=BDMTX
SET DIK="^ATXAX("
DO IX1^DIK
+8 QUIT
DMEDUC ;
+1 WRITE !,"Creating Education topics taxonomy..."
+2 SET BDMDA=0
SET BDMDA=$ORDER(^ATXAX("B","DM AUDIT SMOKING CESS EDUC",BDMDA))
IF 'BDMDA
Begin DoDot:1
+3 SET X="DM AUDIT SMOKING CESS EDUC"
SET DIC="^ATXAX("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002226
DO ^DIC
KILL DIC,DA,DIADD,DLAYGO,I
+4 IF Y=-1
WRITE !!,"ERROR IN CREATING DM AUDIT SMOKING CESS EDUC TAX"
QUIT
+5 SET BDMTX=+Y
SET $PIECE(^ATXAX(BDMTX,0),U,2)="DM AUDIT SMOKING CESS EDUC"
SET $PIECE(^(0),U,5)=DUZ
SET $PIECE(^(0),U,8)=0
SET $PIECE(^(0),U,9)=DT
SET $PIECE(^(0),U,12)=280
SET $PIECE(^(0),U,13)=0
SET $PIECE(^(0),U,15)=9999999.09
SET ^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
+6 SET ^ATXAX(BDMTX,21,BDMX,0)=+Y
SET $PIECE(^ATXAX(BDMTX,21,0),U,3)=BDMX
SET $PIECE(^(0),U,4)=BDMX
SET ^ATXAX(BDMTX,21,"AA",+Y,+Y)=""
+7 SET DA=BDMTX
SET DIK="^ATXAX("
DO IX1^DIK
End DoDot:1
+8 QUIT
