Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BTIUPOS

BTIUPOS.m

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