- APCLP8 ; IHS/CMI/LAB - post init to patch 8 ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;
- D ^APCLBUL
- S ATXX=$O(^ATXAX("B","APCL DIABETES REG NEW CASE",0)) I ATXX D ZTM^ATXAX
- S ATXX=$O(^ATXAX("B","APCL DIABETES REG COMPLICATION",0)) I ATXX D ZTM^ATXAX
- ;add new report to menu
- NEW X
- S X=$$ADD^XPDMENU("APCL M DX/PROC COUNT REPORTS","APCL P RX RELEASE","RXDA")
- I 'X W "Attempt to add RX Data Analysis Report option failed." H 3
- S X=$$ADD^XPDMENU("APCL M MAN QUALITY ASSURANCE","APCLBP IN/OUT CONTROL BPS","BPC")
- I 'X W "Attempt to add RX Data Analysis Report option failed." H 3
- S X=$$ADD^XPDMENU("APCL M MAIN DM MENU","APCL DM PTS NO DX PL","PLDX")
- I 'X W "Attempt to add Patients w/o DM option failed.." H 3
- S X=$$ADD^XPDMENU("APCL M MAIN DM MENU","APCL DM2000 AUDIT MENU","DM20")
- I 'X W "Attempt to add DM 2000 Audit Menu option failed.." H 3
- S X=$$ADD^XPDMENU("APCL M MAIN DM MENU","APCL TAXONOMY SETUP","TS")
- I 'X W "Attempt to add Taxonomy Setup menu option failed.." H 3
- S X=$$ADD^XPDMENU("APCL M MAIN DM MENU","APCL FLOW SHEET SETUP","FS")
- I 'X W "Attempt to add Flow Sheet Setup Menu option failed.." H 3
- S X=$$ADD^XPDMENU("APCL M MAN PATIENT LISTINGS","APCL P ELDER CARE 1","ELFA")
- I 'X W "Attempt to add Elder Care Report 1 option failed." H 3
- S X=$$ADD^XPDMENU("APCL M MAN PATIENT LISTINGS","APCL P ELDER CARE 2","ELFC")
- I 'X W "Attempt to add Elder Care Report 2 option failed." H 3
- S X=$$ADD^XPDMENU("APCL M MAN PATIENT LISTINGS","APCL 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,APCLX,APCLDA,APCLTX
- Q
- LAB ;
- S APCLX="DM AUDIT HDL TAX" D LAB1
- Q
- LAB1 ;
- W !,"Creating ",APCLX," Taxonomy..."
- S APCLDA=$O(^ATXLAB("B",APCLX,0))
- Q:APCLDA ;taxonomy already exisits
- S X=APCLX,DIC="^ATXLAB(",DIC(0)="L",DIADD=1,DLAYGO=9002228 D ^DIC K DIC,DA,DIADD,DLAYGO,I
- I Y=-1 W !!,"ERROR IN CREATING ",APCLX," TAX" Q
- S APCLTX=+Y,$P(^ATXLAB(APCLTX,0),U,2)=APCLX,$P(^(0),U,5)=DUZ,$P(^(0),U,6)=DT,$P(^(0),U,8)="B",$P(^(0),U,9)=60,^ATXLAB(APCLTX,21,0)="^9002228.02101PA^0^0"
- S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
- Q
- DRUGS ;set up drug taxonomies
- S APCLX="DM AUDIT LIPID LOWERING DRUGS" D DRUG1
- Q
- DRUG1 ;
- W !,"Creating ",APCLX," Taxonomy..."
- S APCLDA=$O(^ATXAX("B",APCLX,0))
- Q:APCLDA ;taxonomy already exisits
- S X=APCLX,DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
- I Y=-1 W !!,"ERROR IN CREATING ",APCLX," TAX" Q
- S APCLTX=+Y,$P(^ATXAX(APCLTX,0),U,2)=APCLX,$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(APCLTX,21,0)="^9002226.02101A^0^0"
- S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
- Q
- DMEDUC ;
- W !,"Creating Education topics taxonomy..."
- S APCLDA=0 S APCLDA=$O(^ATXAX("B","DM AUDIT SMOKING CESS EDUC",APCLDA)) I 'APCLDA 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 APCLTX=+Y,$P(^ATXAX(APCLTX,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(APCLTX,21,0)="^9002226.02101A^0^0"
- .S ^ATXAX(APCLTX,21,APCLX,0)=+Y,$P(^ATXAX(APCLTX,21,0),U,3)=APCLX,$P(^(0),U,4)=APCLX,^ATXAX(APCLTX,21,"AA",+Y,+Y)=""
- .S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
- Q
- APCLP8 ; IHS/CMI/LAB - post init to patch 8 ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;
- +3 DO ^APCLBUL
- +4 SET ATXX=$ORDER(^ATXAX("B","APCL DIABETES REG NEW CASE",0))
- IF ATXX
- DO ZTM^ATXAX
- +5 SET ATXX=$ORDER(^ATXAX("B","APCL DIABETES REG COMPLICATION",0))
- IF ATXX
- DO ZTM^ATXAX
- +6 ;add new report to menu
- +7 NEW X
- +8 SET X=$$ADD^XPDMENU("APCL M DX/PROC COUNT REPORTS","APCL P RX RELEASE","RXDA")
- +9 IF 'X
- WRITE "Attempt to add RX Data Analysis Report option failed."
- HANG 3
- +10 SET X=$$ADD^XPDMENU("APCL M MAN QUALITY ASSURANCE","APCLBP 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("APCL M MAIN DM MENU","APCL 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("APCL M MAIN DM MENU","APCL DM2000 AUDIT MENU","DM20")
- +15 IF 'X
- WRITE "Attempt to add DM 2000 Audit Menu option failed.."
- HANG 3
- +16 SET X=$$ADD^XPDMENU("APCL M MAIN DM MENU","APCL TAXONOMY SETUP","TS")
- +17 IF 'X
- WRITE "Attempt to add Taxonomy Setup menu option failed.."
- HANG 3
- +18 SET X=$$ADD^XPDMENU("APCL M MAIN DM MENU","APCL FLOW SHEET SETUP","FS")
- +19 IF 'X
- WRITE "Attempt to add Flow Sheet Setup Menu option failed.."
- HANG 3
- +20 SET X=$$ADD^XPDMENU("APCL M MAN PATIENT LISTINGS","APCL 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("APCL M MAN PATIENT LISTINGS","APCL 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("APCL M MAN PATIENT LISTINGS","APCL 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,APCLX,APCLDA,APCLTX
- +6 QUIT
- LAB ;
- +1 SET APCLX="DM AUDIT HDL TAX"
- DO LAB1
- +2 QUIT
- LAB1 ;
- +1 WRITE !,"Creating ",APCLX," Taxonomy..."
- +2 SET APCLDA=$ORDER(^ATXLAB("B",APCLX,0))
- +3 ;taxonomy already exisits
- IF APCLDA
- QUIT
- +4 SET X=APCLX
- 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 ",APCLX," TAX"
- QUIT
- +6 SET APCLTX=+Y
- SET $PIECE(^ATXLAB(APCLTX,0),U,2)=APCLX
- 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(APCLTX,21,0)="^9002228.02101PA^0^0"
- +7 SET DA=APCLTX
- SET DIK="^ATXAX("
- DO IX1^DIK
- +8 QUIT
- DRUGS ;set up drug taxonomies
- +1 SET APCLX="DM AUDIT LIPID LOWERING DRUGS"
- DO DRUG1
- +2 QUIT
- DRUG1 ;
- +1 WRITE !,"Creating ",APCLX," Taxonomy..."
- +2 SET APCLDA=$ORDER(^ATXAX("B",APCLX,0))
- +3 ;taxonomy already exisits
- IF APCLDA
- QUIT
- +4 SET X=APCLX
- 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 ",APCLX," TAX"
- QUIT
- +6 SET APCLTX=+Y
- SET $PIECE(^ATXAX(APCLTX,0),U,2)=APCLX
- 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(APCLTX,21,0)="^9002226.02101A^0^0"
- +7 SET DA=APCLTX
- SET DIK="^ATXAX("
- DO IX1^DIK
- +8 QUIT
- DMEDUC ;
- +1 WRITE !,"Creating Education topics taxonomy..."
- +2 SET APCLDA=0
- SET APCLDA=$ORDER(^ATXAX("B","DM AUDIT SMOKING CESS EDUC",APCLDA))
- IF 'APCLDA
- 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 APCLTX=+Y
- SET $PIECE(^ATXAX(APCLTX,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(APCLTX,21,0)="^9002226.02101A^0^0"
- +6 SET ^ATXAX(APCLTX,21,APCLX,0)=+Y
- SET $PIECE(^ATXAX(APCLTX,21,0),U,3)=APCLX
- SET $PIECE(^(0),U,4)=APCLX
- SET ^ATXAX(APCLTX,21,"AA",+Y,+Y)=""
- +7 SET DA=APCLTX
- SET DIK="^ATXAX("
- DO IX1^DIK
- End DoDot:1
- +8 QUIT
