- 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 ;;