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
