- 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
