BQI1POST ;PRXM/HC/DLS - BQI Post Installation Routine ; 23 Mar 2006 4:10 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
;
;**Program Description**
; This is the post-installation program to set up values for the
; iCARE System
;
EN ; EP - BQI Post Install
;
; Set up the parameters file with the default location
NEW BGPHOME,BGPHN,BQIDA,FD,BGDATA,IDIN
S BGPHN=$O(^BGPSITE(0)) S:BGPHN BGPHOME=$P($G(^BGPSITE(BGPHN,0)),U,1)
Q:$G(BGPHOME)=""
S BQIDA=1
S BQIUPD(90508,BQIDA_",",.01)=BGPHOME
F FD=.02,.03,.04,.05,.06,.07,1.01,1.02 S BQIUPD(90508,BQIDA_",",FD)="@"
D FILE^DIE("","BQIUPD","ERROR")
;
; Add the GPRA information to the site parameters if 2007 has been installed
; removed 3/15/2007 ALA
;I $$VERSION^XPDUTL("BGP")="7.0" D
;. D EN^BQIGPUPD("2007","90530.01","90530.02","BGP7D10",1)
;
VIS ; Set the last visit IEN
S BQIUPD(90508,BQIDA_",",1)=$O(^AUPNVSIT("A"),-1)
D FILE^DIE("","BQIUPD","ERROR")
;
REM ; Set up the 'ALL REMINDERS' Patient Health Summary Definition
I '$$FIND1^DIC(9001015,"","","ALL REMINDERS","B","","") D
. N X,Y,DA,DR,DIC,DLAYGO,CMPNDX,REMNDX
. ;
. ; Create top level for 'ALL REMINDERS' Hlth Summary
. S X="ALL REMINDERS",DIC(0)="LZ",DLAYGO=9001015,DIC="^APCHSCTL("
. D FILE^DICN
. ;
. ; Build Sort Order Sub-File
. N DIC,DA,DIE,DR,X,BQIUPD
. S DLAYGO=9001015.01
. S (DA(1),REMNDX)=+Y,DA=10,DIC(0)="LZ",DIC="^APCHSCTL("_DA(1)_",1,"
. D FILE^DICN
. ;
. ; Add Component IEN for Reminders (from 9001016) to Hlth Summary
. S CMPNDX=$$FIND1^DIC(9001016,"","","HEALTH MAINTENANCE REMINDERS","B","","")
. Q:'CMPNDX
. S DA(1)=REMNDX,DA=10,DIE=DIC
. S DR=".01///"_DA_";1////"_CMPNDX
. D ^DIE
. ;
. ; Build Health Summary nodes.
. N DIC,DA,NDX,NDX2,RMNDR,X,Y,DR
. S DA(1)=REMNDX,DLAYGO=9001015.06,DIC(0)="LZ"
. S DIC="^APCHSCTL("_DA(1)_",5,"
. D FILE^DICN
. S NDX=""
. F S NDX=$O(^APCHSURV("AC",NDX)) Q:NDX="" D
.. S RMNDR=""
.. F S RMNDR=$O(^APCHSURV("AC",NDX,RMNDR)) Q:RMNDR="" D
... I $$GET1^DIQ(9001018,RMNDR,.03,"I")'="D" D
.... S (DA,NDX2)=(NDX*100)+RMNDR,DIE=DIC
.... S DR=".01///"_NDX2_";1////"_RMNDR
.... D ^DIE
.... Q
;
LTAX ; Add Lab Taxonomies to ^ATXLAB
NEW X,DIC,DLAYGO,DA,DR,DIE,Y,LTAX,D0,DINUM
S DIC="^ATXLAB(",DIC(0)="L",DLAYGO=9002228
; Loop through the Taxonomies as stored in routine BKMVTAX4.
D LDLAB(.LTAX)
F BJ=1:1 Q:'$D(LTAX(BJ)) S X=LTAX(BJ) D
. I $D(^ATXLAB("B",X)) D STXPT(X,"L") Q ; Skip pre-existing Lab taxonomies
. D ^DIC S DA=+Y
. I DA<1 Q
. S BQTXUP(9002228,DA_",",.02)=$P(X," ",2,999)
. S BQTXUP(9002228,DA_",",.05)=DUZ
. S BQTXUP(9002228,DA_",",.06)=DT
. S BQTXUP(9002228,DA_",",.09)=60
. D FILE^DIE("I","BQTXUP")
. S BQTXUP(9002228,DA_",",.08)="B"
. D FILE^DIE("E","BQTXUP")
. D STXPT(X,"L")
;
K DA,BJ,BQTXUP,DIC,DLAYGO,DINUM,D0,DR,X,Y
;
TAX ; Set up the taxonomies
;
D ^BQITX
D ^BQIATX
;
; Reset the variable pointer values for the taxonomies
S N=0
F S N=$O(^BQI(90508,BQIDA,10,N)) Q:'N D
. S X=$P(^BQI(90508,BQIDA,10,N,0),U,1)
. I $P(^BQI(90508,BQIDA,10,N,0),U,3)=5 D STXPT(X,"L") Q
. D STXPT(X,"N")
;
; Reindex the site parameter file
NEW DIK
S DIK="^BQI(90508," D IXALL^DIK
;
; Check taxonomies
NEW IEN,PRGM,X
S IEN=0
F S IEN=$O(^BQI(90508,BQIDA,10,IEN)) Q:'IEN D
. I $P(^BQI(90508,BQIDA,10,IEN,0),U,2)'="" Q
. I $P(^BQI(90508,BQIDA,10,IEN,0),U,3)=5 Q
. S PRGM=U_$P(^BQI(90508,BQIDA,10,IEN,0),U,6)
. D @PRGM
. S X=$P(^BQI(90508,BQIDA,10,IEN,0),U,1)
. D STXPT(X,"N")
;
; Set up tagging program
S ZTDESC="ICARE TAG PROGRAM",ZTRTN="ENT^BQI1POJB",ZTIO=""
S JBNOW=$$NOW^XLFDT()
S JBDATE=$S($E($P(JBNOW,".",2),1,2)<20:DT,1:$$FMADD^XLFDT(DT,+1))
S ZTDTH=JBDATE_".20"
D ^%ZTLOAD
NEW DA,IENS
S DA=BQIDA,IENS=$$IENS^DILF(.DA)
S BQIUPD(90508,IENS,.1)=ZTSK
D FILE^DIE("","BQIUPD","ERROR")
;
K ZTDESC,ZTRTN,ZTIO,JBNOW,JBDATE,ZTDTH,ZTSK,BQIGDA,N,ERROR
K BQIINDG,BQIDA
;
JRN ; Turn off journaling for BQIPAT
NEW %,DIR
S %=$$NOJOURN^ZIBGCHAR("BQIPAT")
I % D
. W !!,"Attempt to turn off journaling for global ^BQIPAT failed because "
. W !?5,$$ERR^ZIBGCHAR(%)
. W !,"Please notify the OIT Help Desk for assistance."
. S DIR(0)="E" D ^DIR
Q
;
STXPT(TXNM,TYP) ; Set taxonomy pointer into Site Parameter file
;
;Input
; TXNM - Taxonomy name
; TYP - Taxonomy Type (L = LAB, N = Non Lab)
NEW IEN,SIEN,DA,IENS,BQUPD,VALUE,GLB
I TYP="L" D
. S IEN=$O(^ATXLAB("B",TXNM,"")),GLB="ATXLAB("
. I IEN="" S TYP="N"
I TYP="N" S IEN=$O(^ATXAX("B",TXNM,"")),GLB="ATXAX("
I IEN="" S VALUE="@"
I IEN'="" S VALUE=IEN_";"_GLB
S SIEN=$O(^BQI(90508,BQIDA,10,"B",TXNM,""))
S DA(1)=BQIDA,DA=SIEN,IENS=$$IENS^DILF(.DA)
S BQUPD(90508.03,IENS,.02)=VALUE
D FILE^DIE("","BQUPD","ERROR")
Q
;
LDLAB(ARRAY) ;EP;Load site-populated Lab tests
NEW I,TEXT
F I=1:1 S TEXT=$P($T(LAB+I),";;",2) Q:TEXT="" S ARRAY(I)=TEXT
Q
;
LAB ;EP;LAB TESTS (SITE-POPULATED)
;;BGP GPRA ESTIMATED GFR TAX
;;DM AUDIT CHOLESTEROL TAX
;;DM AUDIT CREATININE TAX
;;DM AUDIT HDL TAX
;;DM AUDIT LDL CHOLESTEROL TAX
;;DM AUDIT TRIGLYCERIDE TAX
;;DM AUDIT FASTING GLUCOSE TESTS
;;
BQI1POST ;PRXM/HC/DLS - BQI Post Installation Routine ; 23 Mar 2006 4:10 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 ;
+4 ;**Program Description**
+5 ; This is the post-installation program to set up values for the
+6 ; iCARE System
+7 ;
EN ; EP - BQI Post Install
+1 ;
+2 ; Set up the parameters file with the default location
+3 NEW BGPHOME,BGPHN,BQIDA,FD,BGDATA,IDIN
+4 SET BGPHN=$ORDER(^BGPSITE(0))
IF BGPHN
SET BGPHOME=$PIECE($GET(^BGPSITE(BGPHN,0)),U,1)
+5 IF $GET(BGPHOME)=""
QUIT
+6 SET BQIDA=1
+7 SET BQIUPD(90508,BQIDA_",",.01)=BGPHOME
+8 FOR FD=.02,.03,.04,.05,.06,.07,1.01,1.02
SET BQIUPD(90508,BQIDA_",",FD)="@"
+9 DO FILE^DIE("","BQIUPD","ERROR")
+10 ;
+11 ; Add the GPRA information to the site parameters if 2007 has been installed
+12 ; removed 3/15/2007 ALA
+13 ;I $$VERSION^XPDUTL("BGP")="7.0" D
+14 ;. D EN^BQIGPUPD("2007","90530.01","90530.02","BGP7D10",1)
+15 ;
VIS ; Set the last visit IEN
+1 SET BQIUPD(90508,BQIDA_",",1)=$ORDER(^AUPNVSIT("A"),-1)
+2 DO FILE^DIE("","BQIUPD","ERROR")
+3 ;
REM ; Set up the 'ALL REMINDERS' Patient Health Summary Definition
+1 IF '$$FIND1^DIC(9001015,"","","ALL REMINDERS","B","","")
Begin DoDot:1
+2 NEW X,Y,DA,DR,DIC,DLAYGO,CMPNDX,REMNDX
+3 ;
+4 ; Create top level for 'ALL REMINDERS' Hlth Summary
+5 SET X="ALL REMINDERS"
SET DIC(0)="LZ"
SET DLAYGO=9001015
SET DIC="^APCHSCTL("
+6 DO FILE^DICN
+7 ;
+8 ; Build Sort Order Sub-File
+9 NEW DIC,DA,DIE,DR,X,BQIUPD
+10 SET DLAYGO=9001015.01
+11 SET (DA(1),REMNDX)=+Y
SET DA=10
SET DIC(0)="LZ"
SET DIC="^APCHSCTL("_DA(1)_",1,"
+12 DO FILE^DICN
+13 ;
+14 ; Add Component IEN for Reminders (from 9001016) to Hlth Summary
+15 SET CMPNDX=$$FIND1^DIC(9001016,"","","HEALTH MAINTENANCE REMINDERS","B","","")
+16 IF 'CMPNDX
QUIT
+17 SET DA(1)=REMNDX
SET DA=10
SET DIE=DIC
+18 SET DR=".01///"_DA_";1////"_CMPNDX
+19 DO ^DIE
+20 ;
+21 ; Build Health Summary nodes.
+22 NEW DIC,DA,NDX,NDX2,RMNDR,X,Y,DR
+23 SET DA(1)=REMNDX
SET DLAYGO=9001015.06
SET DIC(0)="LZ"
+24 SET DIC="^APCHSCTL("_DA(1)_",5,"
+25 DO FILE^DICN
+26 SET NDX=""
+27 FOR
SET NDX=$ORDER(^APCHSURV("AC",NDX))
IF NDX=""
QUIT
Begin DoDot:2
+28 SET RMNDR=""
+29 FOR
SET RMNDR=$ORDER(^APCHSURV("AC",NDX,RMNDR))
IF RMNDR=""
QUIT
Begin DoDot:3
+30 IF $$GET1^DIQ(9001018,RMNDR,.03,"I")'="D"
Begin DoDot:4
+31 SET (DA,NDX2)=(NDX*100)+RMNDR
SET DIE=DIC
+32 SET DR=".01///"_NDX2_";1////"_RMNDR
+33 DO ^DIE
+34 QUIT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+35 ;
LTAX ; Add Lab Taxonomies to ^ATXLAB
+1 NEW X,DIC,DLAYGO,DA,DR,DIE,Y,LTAX,D0,DINUM
+2 SET DIC="^ATXLAB("
SET DIC(0)="L"
SET DLAYGO=9002228
+3 ; Loop through the Taxonomies as stored in routine BKMVTAX4.
+4 DO LDLAB(.LTAX)
+5 FOR BJ=1:1
IF '$DATA(LTAX(BJ))
QUIT
SET X=LTAX(BJ)
Begin DoDot:1
+6 ; Skip pre-existing Lab taxonomies
IF $DATA(^ATXLAB("B",X))
DO STXPT(X,"L")
QUIT
+7 DO ^DIC
SET DA=+Y
+8 IF DA<1
QUIT
+9 SET BQTXUP(9002228,DA_",",.02)=$PIECE(X," ",2,999)
+10 SET BQTXUP(9002228,DA_",",.05)=DUZ
+11 SET BQTXUP(9002228,DA_",",.06)=DT
+12 SET BQTXUP(9002228,DA_",",.09)=60
+13 DO FILE^DIE("I","BQTXUP")
+14 SET BQTXUP(9002228,DA_",",.08)="B"
+15 DO FILE^DIE("E","BQTXUP")
+16 DO STXPT(X,"L")
End DoDot:1
+17 ;
+18 KILL DA,BJ,BQTXUP,DIC,DLAYGO,DINUM,D0,DR,X,Y
+19 ;
TAX ; Set up the taxonomies
+1 ;
+2 DO ^BQITX
+3 DO ^BQIATX
+4 ;
+5 ; Reset the variable pointer values for the taxonomies
+6 SET N=0
+7 FOR
SET N=$ORDER(^BQI(90508,BQIDA,10,N))
IF 'N
QUIT
Begin DoDot:1
+8 SET X=$PIECE(^BQI(90508,BQIDA,10,N,0),U,1)
+9 IF $PIECE(^BQI(90508,BQIDA,10,N,0),U,3)=5
DO STXPT(X,"L")
QUIT
+10 DO STXPT(X,"N")
End DoDot:1
+11 ;
+12 ; Reindex the site parameter file
+13 NEW DIK
+14 SET DIK="^BQI(90508,"
DO IXALL^DIK
+15 ;
+16 ; Check taxonomies
+17 NEW IEN,PRGM,X
+18 SET IEN=0
+19 FOR
SET IEN=$ORDER(^BQI(90508,BQIDA,10,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+20 IF $PIECE(^BQI(90508,BQIDA,10,IEN,0),U,2)'=""
QUIT
+21 IF $PIECE(^BQI(90508,BQIDA,10,IEN,0),U,3)=5
QUIT
+22 SET PRGM=U_$PIECE(^BQI(90508,BQIDA,10,IEN,0),U,6)
+23 DO @PRGM
+24 SET X=$PIECE(^BQI(90508,BQIDA,10,IEN,0),U,1)
+25 DO STXPT(X,"N")
End DoDot:1
+26 ;
+27 ; Set up tagging program
+28 SET ZTDESC="ICARE TAG PROGRAM"
SET ZTRTN="ENT^BQI1POJB"
SET ZTIO=""
+29 SET JBNOW=$$NOW^XLFDT()
+30 SET JBDATE=$SELECT($EXTRACT($PIECE(JBNOW,".",2),1,2)<20:DT,1:$$FMADD^XLFDT(DT,+1))
+31 SET ZTDTH=JBDATE_".20"
+32 DO ^%ZTLOAD
+33 NEW DA,IENS
+34 SET DA=BQIDA
SET IENS=$$IENS^DILF(.DA)
+35 SET BQIUPD(90508,IENS,.1)=ZTSK
+36 DO FILE^DIE("","BQIUPD","ERROR")
+37 ;
+38 KILL ZTDESC,ZTRTN,ZTIO,JBNOW,JBDATE,ZTDTH,ZTSK,BQIGDA,N,ERROR
+39 KILL BQIINDG,BQIDA
+40 ;
JRN ; Turn off journaling for BQIPAT
+1 NEW %,DIR
+2 SET %=$$NOJOURN^ZIBGCHAR("BQIPAT")
+3 IF %
Begin DoDot:1
+4 WRITE !!,"Attempt to turn off journaling for global ^BQIPAT failed because "
+5 WRITE !?5,$$ERR^ZIBGCHAR(%)
+6 WRITE !,"Please notify the OIT Help Desk for assistance."
+7 SET DIR(0)="E"
DO ^DIR
End DoDot:1
+8 QUIT
+9 ;
STXPT(TXNM,TYP) ; Set taxonomy pointer into Site Parameter file
+1 ;
+2 ;Input
+3 ; TXNM - Taxonomy name
+4 ; TYP - Taxonomy Type (L = LAB, N = Non Lab)
+5 NEW IEN,SIEN,DA,IENS,BQUPD,VALUE,GLB
+6 IF TYP="L"
Begin DoDot:1
+7 SET IEN=$ORDER(^ATXLAB("B",TXNM,""))
SET GLB="ATXLAB("
+8 IF IEN=""
SET TYP="N"
End DoDot:1
+9 IF TYP="N"
SET IEN=$ORDER(^ATXAX("B",TXNM,""))
SET GLB="ATXAX("
+10 IF IEN=""
SET VALUE="@"
+11 IF IEN'=""
SET VALUE=IEN_";"_GLB
+12 SET SIEN=$ORDER(^BQI(90508,BQIDA,10,"B",TXNM,""))
+13 SET DA(1)=BQIDA
SET DA=SIEN
SET IENS=$$IENS^DILF(.DA)
+14 SET BQUPD(90508.03,IENS,.02)=VALUE
+15 DO FILE^DIE("","BQUPD","ERROR")
+16 QUIT
+17 ;
LDLAB(ARRAY) ;EP;Load site-populated Lab tests
+1 NEW I,TEXT
+2 FOR I=1:1
SET TEXT=$PIECE($TEXT(LAB+I),";;",2)
IF TEXT=""
QUIT
SET ARRAY(I)=TEXT
+3 QUIT
+4 ;
LAB ;EP;LAB TESTS (SITE-POPULATED)
+1 ;;BGP GPRA ESTIMATED GFR TAX
+2 ;;DM AUDIT CHOLESTEROL TAX
+3 ;;DM AUDIT CREATININE TAX
+4 ;;DM AUDIT HDL TAX
+5 ;;DM AUDIT LDL CHOLESTEROL TAX
+6 ;;DM AUDIT TRIGLYCERIDE TAX
+7 ;;DM AUDIT FASTING GLUCOSE TESTS
+8 ;;
