BTIUPOS ; IHS/ITSC/LJF - IHS post initialization actions ;
;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004
;
Q
;
CLEAN ;EP; clean up item lists in TIU files
; TIU Document Definition file
; remove those items listed under a class or document class that
; were not included in the distribution
;
D BMES^XPDUTL("Remove bad pointers under class and document class groupings . . .")
NEW DOC,IEN,X,DIK,DA
S DOC=0 F S DOC=$O(^TIU(8925.1,DOC)) Q:'DOC D
. S IEN=0 F S IEN=$O(^TIU(8925.1,DOC,10,IEN)) Q:'IEN D
. . S X=$P(^TIU(8925.1,DOC,10,IEN,0),U) ;item pointer
. . I $D(^TIU(8925.1,X,0)) Q ;skip if pointer is good
. . ;
. . S DIK="^TIU(8925.1,"_DOC_",10,",DA(1)=DOC,DA=IEN
. . D ^DIK ;remove bad pointer
;
; reindex AAU xref on TIU Document Definition file
D BMES^XPDUTL("Reindiexing AAU xref in TIU Document Definition file . . .")
K ^TIU(8925,"AAU")
S DIK="^TIU(8925,",DIK(1)="1202^AAU" D ENALL^DIK
;
; TIU Template file
; --- remove items under each entry where pointer is set to -1
D BMES^XPDUTL("Cleaning up bad pointer in TIU Template file . . .")
NEW IEN,IEN2,DIK,DA,X
S IEN=0 F S IEN=$O(^TIU(8927,IEN)) Q:'IEN D
. S IEN2=0 F S IEN2=$O(^TIU(8927,IEN,10,IEN2)) Q:'IEN2 D
. . S X=$P(^TIU(8927,IEN,10,IEN2,0),U,2)
. . Q:$D(^TIU(8927,X,0)) ;skip if good pointer
. . ;
. . S DIK="^TIU(8927,"_IEN_",10,",DA(1)=IEN,DA=IEN2
. . D ^DIK ;remove bad pointer
;
; --- make sure patient/visit objects set up okay
D OBJ
;
D BMES^XPDUTL("Updating Object Methods . . .")
; remove write access to Object Method if still set
I ^DD(8925.1,9,9)="@" S ^DD(8925.1,9,9)=""
;
; modify Object Method for 3 inpt objects
NEW OBJ,DIE,DR,DA,X,Y
S DIE="^TIU(8925.1,"
S DA=$O(^TIU(8925.1,"B","ADMITTING PROVIDER",0))
I $$GET1^DIQ(8925.1,+DA,.04)="OBJECT" D
. S DR="9///S X=$$CURPRV^BTIULO6(DFN,""ADM"")" D ^DIE
;
S DA=$O(^TIU(8925.1,"B","REFERRING PROVIDER",0))
I $$GET1^DIQ(8925.1,+DA,.04)="OBJECT" D
. S DR="9///S X=$$CURPRV^BTIULO6(DFN,""REF"")" D ^DIE
;
S DA=$O(^TIU(8925.1,"B","CURRENT ATTENDING",0))
I $$GET1^DIQ(8925.1,+DA,.04)="OBJECT" D
. S DR="9///S X=$$CURPRV^BTIULO6(DFN,""ATT"")" D ^DIE
;
; clean up Object Description file if items not installed correctly
; KIDS does not resolve pointers so .01 field must be checked
D OBJCHK^BTIUPOS3
Q
;
DDMFIX ;EP; update upload error filing code for progress notes and consults
; KIDS install won't update this if document definition already there
; change was released in VA patch 131 seq 127
D BMES^XPDUTL("Updating error filing code; VA patch 131 seq 127 . . .")
NEW DIE,DA,DR,CONS
S DIE=8925.1,DA=3,DR="4.8///D PNFIX^TIUPNFIX" D ^DIE ;fix progress notes
;
S CONS=0 F S CONS=$O(^TIU(8925.1,"B","CONSULTS",CONS)) Q:'CONS D
. Q:$$GET1^DIQ(8925.1,CONS,4.8)="" ;if nothing there, don't update
. S DIE=8925.1,DA=CONS,DR="4.8///D CNFIX^TIUCNFIX" D ^DIE ;fix consults
Q
;
PCCLNK ;EP -- add TIU to PCC Visit Merge Utility
D BMES^XPDUTL("Adding TIU to PCC Visit Merge Utility . . .")
Q:$D(^APCDLINK("B","TEXT INTEGRATION UTILITY")) ;already exists
NEW DD,DO,DIC,DLAYGO,X,Y
S DIC="^APCDLINK(",DIC(0)="LE",DLAYGO=9001002
S DIC("DR")="1///I $L($T(MRG^BTIULINK)) D MRG^BTIULINK"
S DIC("DR")=DIC("DR")_";.02///TIU"
S X="TEXT INTEGRATION UTILITY" D FILE^DICN
Q
;
VSTLINK ;EP -- add TIU to Visit Tracking file so TIU can create visits in EHR
D BMES^XPDUTL("Adding TIU to VISIT TRACKING file . . .")
NEW PKG,DD,DO,DIC,X,DLAYGO
S PKG=$O(^DIC(9.4,"C","TIU",0)) Q:'PKG
Q:$D(^DIC(150.9,1,3,"B",PKG)) ;already exists
S DIC="^DIC(150.9,1,3,",DIC(0)="L",DLAYGO=150.93,DA(1)=1
S DIC("P")=$P(^DD(150.9,3,0),U,2)
S X="TEXT INTEGRATION UTILITIES",DIC("DR")="4///1"
D ^DIC
Q
;
OBJ ; add new objects in TIU Template file to class containers
; either add to Patient Data Objects or Patient Inpt Objects
;
D BMES^XPDUTL("Resequencing patient objects . . .")
; first make sure Patient Inpt Objects listed under Shared Templates
NEW X,PIO,ST,Y,DIC
S PIO=$$PTR("Patient Inpatient Objects") Q:PIO<1
S ST=$$PTR("Shared Templates") Q:ST<1
I '$D(^TIU(8927,"AD",PIO,ST)) D
. S DIC="^TIU(8927,"_ST_",10,",DA(1)=ST,DIC(0)="L"
. S DIC("P")=$P(^DD(8927,10,0),U,2),DIC("DR")=".02///"_PIO
. S X=$O(^TIU(8927,ST,10,"B",9999),-1),X=X+1
. D ^DIC
;
; re-sequence items under Object containers; add any that are missing
NEW BTIUN
F BTIUN="Patient Data Objects^NEWOBJ","Patient Inpatient Objects^NEWINPT" D
. NEW PDO,IEN,NAME,BTIUX,LINE,NUM,DIC,DA,X,Y,SEQ,DIE,DR,BTIUP,BTIUQ
. S PDO=$$PTR($P(BTIUN,U)) Q:PDO<1
. ; put all objects under class container, in temporary alphabetical array
. S IEN=0 F S IEN=$O(^TIU(8927,PDO,10,IEN)) Q:'IEN D
.. S NAME=$$GET1^DIQ(8927.03,IEN_","_PDO,.02) Q:NAME=""
.. S BTIUX(NAME)=IEN
. ;
. ; find all new objects not under container
. S BTIUQ=+$O(^TIU(8927,PDO,10,"B",9999),-1) ;find highest sequence already entered for container
. S LINE=$P(BTIUN,U,2) ;name of line label
. F NUM=1:1 S NAME=$P($T(@LINE+NUM),";;",2) Q:NAME="" I '$D(BTIUX(NAME)) D
.. S BTIUP=$$PTR(NAME) Q:BTIUP<1 ;not in file
.. S DIC="^TIU(8927,"_PDO_",10,",DA(1)=PDO,DIC(0)="L"
.. S DIC("P")=$P(^DD(8927,10,0),U,2)
.. S X=BTIUQ+1,DIC("DR")=".02///"_NAME
.. D ^DIC
.. I Y>0 S BTIUQ=BTIUQ+1,BTIUX(NAME)=+Y
. ;
. ; now put full list in alpha order in file
. S (SEQ,NAME)=0 F S NAME=$O(BTIUX(NAME)) Q:NAME="" D
.. S SEQ=SEQ+1
.. S DIE="^TIU(8927,"_PDO_",10,",DA(1)=PDO,DA=+BTIUX(NAME)
.. S DR=".01///"_SEQ
.. D ^DIE
;
;inactivate obsolete object (INSERT_USERS_ORDERS
S DA=$O(^TIU(8925.1,"B","INSERT_USERS_ORDERS",0))
I DA S DIE=8925.1,DR=".07////INACTIVE" D ^DIE
;
; fix HL7 codes for Flu shot objects
S DA=$O(^TIU(8925.1,"B","LAST FLU SHOT",0))
I DA S ^TIU(8925.1,DA,9)="S X=$$LASTIMM^BTIULO2(+$G(DFN),""15^16^88^111;FLU SHOT"",1)"
;
S DA=$O(^TIU(8925.1,"B","LAST FLU SHOT DATE",0))
I DA S ^TIU(8925.1,DA,9)="S X=$$LASTIMM^BTIULO2(+$G(DFN),""15^16^88^111;FLU SHOT"",0)"
;
Q
;
PTR(X) ; returns IEN in TIU Template file for name in X
NEW DIC,Y
S DIC=8927,DIC(0)="X" D ^DIC
Q +Y
;
NEWOBJ ;;
;;Address-One Line;;
;;Emergency Contact;;
;;Immunizations Due;;
;;Visit Chief Complaint;;
;;Visit CPT Codes;;
;;Visit Immunizations;;
;;Visit Labs;;
;;Visit Orders;;
;;Visit Pat Education;;
;;Visit Pat Education Multi-Line;;
;;visit POV;;
;;Visit POV Multi-Line;;
;;Visit Procedures;;
;;Visit Procedures Multi-Line;;
;;Visit Skin Tests;;
;;Visit Vitals - Brief;;
;;Visit Vitals - Detailed;;
;;BMI;;
;;Community;;
;;Eligibility;;
;;Future Appointments;;
;;Last Flu Shot;;
;;Last Mammogram;;
;;Last Pap;;
;;Last Pneumovax;;
;;MH Meds Manager;;
;;MH Provider;;
;;Patient Address;;
;;Patient Age - Detailed;;
;;Patient Phone;;
;;Primary Care Provider;;
;;Religion;;
;;Problems-Active;;
;;Problems-Inactive;;
;;Problems-Updated;;
;;
NEWINPT ;;
;;Admitting Dx;;
;;Admitting Provider;;
;;Current Admission;;
;;Current Attending;;
;;Current Diet;;
;;Current Inpt Service;;
;;Current Ward;;
;;Current Ward-Room;;
;;Referring Provider;;
BTIUPOS ; IHS/ITSC/LJF - IHS post initialization actions ;
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004
+2 ;
+3 QUIT
+4 ;
CLEAN ;EP; clean up item lists in TIU files
+1 ; TIU Document Definition file
+2 ; remove those items listed under a class or document class that
+3 ; were not included in the distribution
+4 ;
+5 DO BMES^XPDUTL("Remove bad pointers under class and document class groupings . . .")
+6 NEW DOC,IEN,X,DIK,DA
+7 SET DOC=0
FOR
SET DOC=$ORDER(^TIU(8925.1,DOC))
IF 'DOC
QUIT
Begin DoDot:1
+8 SET IEN=0
FOR
SET IEN=$ORDER(^TIU(8925.1,DOC,10,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+9 ;item pointer
SET X=$PIECE(^TIU(8925.1,DOC,10,IEN,0),U)
+10 ;skip if pointer is good
IF $DATA(^TIU(8925.1,X,0))
QUIT
+11 ;
+12 SET DIK="^TIU(8925.1,"_DOC_",10,"
SET DA(1)=DOC
SET DA=IEN
+13 ;remove bad pointer
DO ^DIK
End DoDot:2
End DoDot:1
+14 ;
+15 ; reindex AAU xref on TIU Document Definition file
+16 DO BMES^XPDUTL("Reindiexing AAU xref in TIU Document Definition file . . .")
+17 KILL ^TIU(8925,"AAU")
+18 SET DIK="^TIU(8925,"
SET DIK(1)="1202^AAU"
DO ENALL^DIK
+19 ;
+20 ; TIU Template file
+21 ; --- remove items under each entry where pointer is set to -1
+22 DO BMES^XPDUTL("Cleaning up bad pointer in TIU Template file . . .")
+23 NEW IEN,IEN2,DIK,DA,X
+24 SET IEN=0
FOR
SET IEN=$ORDER(^TIU(8927,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+25 SET IEN2=0
FOR
SET IEN2=$ORDER(^TIU(8927,IEN,10,IEN2))
IF 'IEN2
QUIT
Begin DoDot:2
+26 SET X=$PIECE(^TIU(8927,IEN,10,IEN2,0),U,2)
+27 ;skip if good pointer
IF $DATA(^TIU(8927,X,0))
QUIT
+28 ;
+29 SET DIK="^TIU(8927,"_IEN_",10,"
SET DA(1)=IEN
SET DA=IEN2
+30 ;remove bad pointer
DO ^DIK
End DoDot:2
End DoDot:1
+31 ;
+32 ; --- make sure patient/visit objects set up okay
+33 DO OBJ
+34 ;
+35 DO BMES^XPDUTL("Updating Object Methods . . .")
+36 ; remove write access to Object Method if still set
+37 IF ^DD(8925.1,9,9)="@"
SET ^DD(8925.1,9,9)=""
+38 ;
+39 ; modify Object Method for 3 inpt objects
+40 NEW OBJ,DIE,DR,DA,X,Y
+41 SET DIE="^TIU(8925.1,"
+42 SET DA=$ORDER(^TIU(8925.1,"B","ADMITTING PROVIDER",0))
+43 IF $$GET1^DIQ(8925.1,+DA,.04)="OBJECT"
Begin DoDot:1
+44 SET DR="9///S X=$$CURPRV^BTIULO6(DFN,""ADM"")"
DO ^DIE
End DoDot:1
+45 ;
+46 SET DA=$ORDER(^TIU(8925.1,"B","REFERRING PROVIDER",0))
+47 IF $$GET1^DIQ(8925.1,+DA,.04)="OBJECT"
Begin DoDot:1
+48 SET DR="9///S X=$$CURPRV^BTIULO6(DFN,""REF"")"
DO ^DIE
End DoDot:1
+49 ;
+50 SET DA=$ORDER(^TIU(8925.1,"B","CURRENT ATTENDING",0))
+51 IF $$GET1^DIQ(8925.1,+DA,.04)="OBJECT"
Begin DoDot:1
+52 SET DR="9///S X=$$CURPRV^BTIULO6(DFN,""ATT"")"
DO ^DIE
End DoDot:1
+53 ;
+54 ; clean up Object Description file if items not installed correctly
+55 ; KIDS does not resolve pointers so .01 field must be checked
+56 DO OBJCHK^BTIUPOS3
+57 QUIT
+58 ;
DDMFIX ;EP; update upload error filing code for progress notes and consults
+1 ; KIDS install won't update this if document definition already there
+2 ; change was released in VA patch 131 seq 127
+3 DO BMES^XPDUTL("Updating error filing code; VA patch 131 seq 127 . . .")
+4 NEW DIE,DA,DR,CONS
+5 ;fix progress notes
SET DIE=8925.1
SET DA=3
SET DR="4.8///D PNFIX^TIUPNFIX"
DO ^DIE
+6 ;
+7 SET CONS=0
FOR
SET CONS=$ORDER(^TIU(8925.1,"B","CONSULTS",CONS))
IF 'CONS
QUIT
Begin DoDot:1
+8 ;if nothing there, don't update
IF $$GET1^DIQ(8925.1,CONS,4.8)=""
QUIT
+9 ;fix consults
SET DIE=8925.1
SET DA=CONS
SET DR="4.8///D CNFIX^TIUCNFIX"
DO ^DIE
End DoDot:1
+10 QUIT
+11 ;
PCCLNK ;EP -- add TIU to PCC Visit Merge Utility
+1 DO BMES^XPDUTL("Adding TIU to PCC Visit Merge Utility . . .")
+2 ;already exists
IF $DATA(^APCDLINK("B","TEXT INTEGRATION UTILITY"))
QUIT
+3 NEW DD,DO,DIC,DLAYGO,X,Y
+4 SET DIC="^APCDLINK("
SET DIC(0)="LE"
SET DLAYGO=9001002
+5 SET DIC("DR")="1///I $L($T(MRG^BTIULINK)) D MRG^BTIULINK"
+6 SET DIC("DR")=DIC("DR")_";.02///TIU"
+7 SET X="TEXT INTEGRATION UTILITY"
DO FILE^DICN
+8 QUIT
+9 ;
VSTLINK ;EP -- add TIU to Visit Tracking file so TIU can create visits in EHR
+1 DO BMES^XPDUTL("Adding TIU to VISIT TRACKING file . . .")
+2 NEW PKG,DD,DO,DIC,X,DLAYGO
+3 SET PKG=$ORDER(^DIC(9.4,"C","TIU",0))
IF 'PKG
QUIT
+4 ;already exists
IF $DATA(^DIC(150.9,1,3,"B",PKG))
QUIT
+5 SET DIC="^DIC(150.9,1,3,"
SET DIC(0)="L"
SET DLAYGO=150.93
SET DA(1)=1
+6 SET DIC("P")=$PIECE(^DD(150.9,3,0),U,2)
+7 SET X="TEXT INTEGRATION UTILITIES"
SET DIC("DR")="4///1"
+8 DO ^DIC
+9 QUIT
+10 ;
OBJ ; add new objects in TIU Template file to class containers
+1 ; either add to Patient Data Objects or Patient Inpt Objects
+2 ;
+3 DO BMES^XPDUTL("Resequencing patient objects . . .")
+4 ; first make sure Patient Inpt Objects listed under Shared Templates
+5 NEW X,PIO,ST,Y,DIC
+6 SET PIO=$$PTR("Patient Inpatient Objects")
IF PIO<1
QUIT
+7 SET ST=$$PTR("Shared Templates")
IF ST<1
QUIT
+8 IF '$DATA(^TIU(8927,"AD",PIO,ST))
Begin DoDot:1
+9 SET DIC="^TIU(8927,"_ST_",10,"
SET DA(1)=ST
SET DIC(0)="L"
+10 SET DIC("P")=$PIECE(^DD(8927,10,0),U,2)
SET DIC("DR")=".02///"_PIO
+11 SET X=$ORDER(^TIU(8927,ST,10,"B",9999),-1)
SET X=X+1
+12 DO ^DIC
End DoDot:1
+13 ;
+14 ; re-sequence items under Object containers; add any that are missing
+15 NEW BTIUN
+16 FOR BTIUN="Patient Data Objects^NEWOBJ","Patient Inpatient Objects^NEWINPT"
Begin DoDot:1
+17 NEW PDO,IEN,NAME,BTIUX,LINE,NUM,DIC,DA,X,Y,SEQ,DIE,DR,BTIUP,BTIUQ
+18 SET PDO=$$PTR($PIECE(BTIUN,U))
IF PDO<1
QUIT
+19 ; put all objects under class container, in temporary alphabetical array
+20 SET IEN=0
FOR
SET IEN=$ORDER(^TIU(8927,PDO,10,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+21 SET NAME=$$GET1^DIQ(8927.03,IEN_","_PDO,.02)
IF NAME=""
QUIT
+22 SET BTIUX(NAME)=IEN
End DoDot:2
+23 ;
+24 ; find all new objects not under container
+25 ;find highest sequence already entered for container
SET BTIUQ=+$ORDER(^TIU(8927,PDO,10,"B",9999),-1)
+26 ;name of line label
SET LINE=$PIECE(BTIUN,U,2)
+27 FOR NUM=1:1
SET NAME=$PIECE($TEXT(@LINE+NUM),";;",2)
IF NAME=""
QUIT
IF '$DATA(BTIUX(NAME))
Begin DoDot:2
+28 ;not in file
SET BTIUP=$$PTR(NAME)
IF BTIUP<1
QUIT
+29 SET DIC="^TIU(8927,"_PDO_",10,"
SET DA(1)=PDO
SET DIC(0)="L"
+30 SET DIC("P")=$PIECE(^DD(8927,10,0),U,2)
+31 SET X=BTIUQ+1
SET DIC("DR")=".02///"_NAME
+32 DO ^DIC
+33 IF Y>0
SET BTIUQ=BTIUQ+1
SET BTIUX(NAME)=+Y
End DoDot:2
+34 ;
+35 ; now put full list in alpha order in file
+36 SET (SEQ,NAME)=0
FOR
SET NAME=$ORDER(BTIUX(NAME))
IF NAME=""
QUIT
Begin DoDot:2
+37 SET SEQ=SEQ+1
+38 SET DIE="^TIU(8927,"_PDO_",10,"
SET DA(1)=PDO
SET DA=+BTIUX(NAME)
+39 SET DR=".01///"_SEQ
+40 DO ^DIE
End DoDot:2
End DoDot:1
+41 ;
+42 ;inactivate obsolete object (INSERT_USERS_ORDERS
+43 SET DA=$ORDER(^TIU(8925.1,"B","INSERT_USERS_ORDERS",0))
+44 IF DA
SET DIE=8925.1
SET DR=".07////INACTIVE"
DO ^DIE
+45 ;
+46 ; fix HL7 codes for Flu shot objects
+47 SET DA=$ORDER(^TIU(8925.1,"B","LAST FLU SHOT",0))
+48 IF DA
SET ^TIU(8925.1,DA,9)="S X=$$LASTIMM^BTIULO2(+$G(DFN),""15^16^88^111;FLU SHOT"",1)"
+49 ;
+50 SET DA=$ORDER(^TIU(8925.1,"B","LAST FLU SHOT DATE",0))
+51 IF DA
SET ^TIU(8925.1,DA,9)="S X=$$LASTIMM^BTIULO2(+$G(DFN),""15^16^88^111;FLU SHOT"",0)"
+52 ;
+53 QUIT
+54 ;
PTR(X) ; returns IEN in TIU Template file for name in X
+1 NEW DIC,Y
+2 SET DIC=8927
SET DIC(0)="X"
DO ^DIC
+3 QUIT +Y
+4 ;
NEWOBJ ;;
+1 ;;Address-One Line;;
+2 ;;Emergency Contact;;
+3 ;;Immunizations Due;;
+4 ;;Visit Chief Complaint;;
+5 ;;Visit CPT Codes;;
+6 ;;Visit Immunizations;;
+7 ;;Visit Labs;;
+8 ;;Visit Orders;;
+9 ;;Visit Pat Education;;
+10 ;;Visit Pat Education Multi-Line;;
+11 ;;visit POV;;
+12 ;;Visit POV Multi-Line;;
+13 ;;Visit Procedures;;
+14 ;;Visit Procedures Multi-Line;;
+15 ;;Visit Skin Tests;;
+16 ;;Visit Vitals - Brief;;
+17 ;;Visit Vitals - Detailed;;
+18 ;;BMI;;
+19 ;;Community;;
+20 ;;Eligibility;;
+21 ;;Future Appointments;;
+22 ;;Last Flu Shot;;
+23 ;;Last Mammogram;;
+24 ;;Last Pap;;
+25 ;;Last Pneumovax;;
+26 ;;MH Meds Manager;;
+27 ;;MH Provider;;
+28 ;;Patient Address;;
+29 ;;Patient Age - Detailed;;
+30 ;;Patient Phone;;
+31 ;;Primary Care Provider;;
+32 ;;Religion;;
+33 ;;Problems-Active;;
+34 ;;Problems-Inactive;;
+35 ;;Problems-Updated;;
+36 ;;
NEWINPT ;;
+1 ;;Admitting Dx;;
+2 ;;Admitting Provider;;
+3 ;;Current Admission;;
+4 ;;Current Attending;;
+5 ;;Current Diet;;
+6 ;;Current Inpt Service;;
+7 ;;Current Ward;;
+8 ;;Current Ward-Room;;
+9 ;;Referring Provider;;
