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

VBECPOST.m

Go to the documentation of this file. 
  1. VBECPOST ;HIOFO;BNT VBECS 1.0 Post Install Routine ; 01/28/05 11:17
  1.  ;;2.0;VBEC;;Jun 05, 2015;Build 4
  1.  ;
  1.  ; Note: This routine supports data exchange with an FDA registered
  1.  ; medical device. As such, it may not be changed in any way without
  1.  ; prior written approval from the medical device manufacturer.
  1.  ; 
  1.  ; Integration Agreements:
  1.  ; Call to XPDUTL is supported by IA: #10141
  1.  ; Call to FILE^DICN is supported by IA: #10009
  1.  ; Call to FIND1^DIC is supported by IA: #
  1.  ; Reference to File 60 supported by IA: #10054
  1.  ; Reference to File 61 supported by IA: #10055
  1.  ; Reference to File 62 supported by IA: #
  1.  ; Reference to File 4  supported by IA: #10090
  1.  ;
  1. EN ;
  1.  ; Add 'OTHER' TOPOGRAPHY FIELD if it doesn't exist.
  1.  I '$$TOPOG() Q
  1.  ; Add 'VBECS - NO SPECIMEN REQUIRED' COLLECTION SAMPLE if it doesn't exist.
  1.  I '$$COLSAMP() Q
  1.  ; Add 'VBECS...' LABORATORY TESTS if they don't exist.
  1.  D LABTSTS
  1.  ; Add PARAMETERS
  1.  D XPAR
  1.  ; Add Generic Blood Inventory for Lab workload processing
  1.  D BLDINV
  1.  ;
  1.  Q
  1.  ;
  1. TOPOG() ; Make sure the 'OTHER' TOPOGRAPHY FIELD file 61 entry exists.
  1.  D BMES^XPDUTL("Adding 'OTHER' TOPOGRAPHY FIELD.")
  1.  D FIND^DIC(61,"","","","OTHER","","","","","OUT","ERR")
  1.  I $D(OUT("DILIST",1,1)) D  Q 1
  1.  . D MES^XPDUTL("   'OTHER' TOPOGRAPHY FIELD already exists.")
  1.  N VBECFDA
  1.  S VBECFDA(1,61,"+1,",.01)="OTHER"
  1.  S VBECFDA(1,61,"+1,",2)="OTHER"
  1.  D UPDATE^DIE("E","VBECFDA(1)","","OUT")
  1.  I $D(OUT("ERROR")) D  Q 0
  1.  . D MES^XPDUTL("   ***Error adding 'OTHER' TOPOGRAPHY FIELD.***")
  1.  D MES^XPDUTL("   'OTHER' TOPOGRAPHY FIELD added successfully.")
  1.  Q $S($D(OUT("ERROR")):0,1:1)
  1.  ;
  1. COLSAMP() ; Add the VBECS NO SPECIMEN REQUIRED entry to file 62
  1.  D BMES^XPDUTL("Adding 'VBECS - NO SPECIMEN REQUIRED' COLLECTION SAMPLE.")
  1.  N VBIENS,VBECFDA,CNT,OUT
  1.  D FIND^DIC(62,"","","","VBECS - NO SPECIMEN REQUIRED","","","","","OUT","ERR")
  1.  I $D(OUT("DILIST",1,1)) D  Q OUT("DILIST",2,1)
  1.  . D MES^XPDUTL("   'VBECS - NO SPECIMEN REQUIRED' COLLECTION SAMPLE already exists.")
  1.  S CNT=2
  1.  S VBECFDA(1,62,"+1,",.01)="VBECS - NO SPECIMEN REQUIRED"
  1.  S VBECFDA(1,62,"+1,",2)="OTHER"
  1.  S VBECFDA(1,62,"+1,",6)="BLOOD BANK"
  1.  S VBECFDA(1,62,"+1,",7)="NO"
  1.  S VBECFDA(1,62.01,"+"_CNT_",+1,",.01)="NRQ"
  1.  ;D ACNAREA(.VBECARY)
  1.  ;F VBECI=1:1 S VBECX=$G(VBECARY(VBECI)) Q:VBECX=""  D
  1.  ;. S CNT=CNT+1
  1.  ;. S VBECFDA(1,62.02,"+"_CNT_",+1,",.01)=$P(VBECX,"^")
  1.  D UPDATE^DIE("E","VBECFDA(1)","VBIENS","OUT")
  1.  I $D(OUT("DIERR")) D  Q 0
  1.  . D MES^XPDUTL("   ***Error adding 'VBECS - NO SPECIMEN REQUIRED' COLLECTION SAMPLE.***")
  1.  I $D(VBIENS(1)) S VBECARY="" D ACNAREA(.VBECARY) F VBECI=1:1 S VBECARY=$O(VBECARY(VBECARY)) Q:VBECARY=""  D
  1.   . S ^LAB(62,VBIENS(1),9,0)="^62.02PA^"_VBECARY_"^"_VBECI
  1.   . S ^LAB(62,VBIENS(1),9,$P(VBECARY(VBECARY),"^",3),0)=$P(VBECARY(VBECARY),"^",3)
  1.  D MES^XPDUTL("   'VBECS - NO SPECIMEN REQUIRED' COLLECTION SAMPLE added successfully.")
  1.  Q VBIENS(1)
  1.  ;
  1. LABTSTS ; Add the VBECS Lab Tests to file 60
  1.  ; Input: VBSAMP = IEN of the VBECS - NO SPECIMEN REQUIRED
  1.  ;                 Collection Sample file #62 entry.
  1.  D BMES^XPDUTL("Adding 'VBECS...' LABORATORY TESTS.")
  1.  N VBECFDA,CNT,OUT,VBECLIEN
  1.  D ACNAREA(.VBECARY)
  1.  ;
  1.  S CNT=2
  1.  F VBECI=2:1  S VBDATA=$P($T(LST+VBECI),";;",2) Q:VBDATA["***"  D
  1.  . D FIND^DIC(60,"","","",$P(VBDATA,"^",1),"","","","","OUT","ERR")
  1.  . I $D(OUT("DILIST",1,1)) D  Q
  1.  . . D MES^XPDUTL("'"_$P(VBDATA,"^",1)_"' LABORATORY TEST already exists.")
  1.  . D MES^XPDUTL("---Adding '"_$P(VBDATA,"^",1)_"' LABORATORY TEST.")
  1.  . ;
  1.  . N VBECLIEN,VBECFDA,VBIENS,OUT
  1.  . S VBECFDA(1,60,"+1,",.01)=$P(VBDATA,"^",1)
  1.  . S VBECFDA(1,60,"+1,",3)="O"
  1.  . S VBECFDA(1,60,"+1,",17)=$O(^LAB(62.05,"B","STAT",0))
  1.  . S VBECFDA(1,60,"+1,",51)=$P(VBDATA,"^",4)
  1.  . S VBECFDA(1,60,"+1,",4)="BB"
  1.  . S VBECFDA(1,60,"+1,",8)=$P(VBDATA,"^",7)
  1.  . ;
  1.  . I $P(VBDATA,"^",6)="NRQ" D
  1.  . . S VBECFDA(1,60.03,"+"_CNT_",+1,",.01)=$O(^LAB(62,"B","VBECS - NO SPECIMEN REQUIRED",0))
  1.  . I $P(VBDATA,"^",6)="" D
  1.  . . S VBCOL=$$DIR($P(VBDATA,"^",1))
  1.  . . I +VBCOL S VBECFDA(1,60.03,"+"_CNT_",+1,",.01)=+VBCOL
  1.  . D UPDATE^DIE("","VBECFDA(1)","VBIENS","OUT")
  1.  . I $D(OUT("DIERR")) D  Q
  1.  . . D MES^XPDUTL("   ***Error adding '"_$P(VBDATA,"^",1)_"' LABORATORY TEST***.")
  1.  . . I $D(^LAB(60,"B",$P(VBDATA,"^",1))) D
  1.  . . . D MES^XPDUTL("   Deleting entry...")
  1.  . . . S DA=$O(^LAB(60,"B",$P(VBDATA,"^",1),0)) K DO
  1.  . . . S DIE="^LAB(60,",DR=".01///@",DIDEL=60
  1.  . . . D ^DIE
  1.  . I $D(VBECARY),VBIENS(1),'$D(OUT("DIERR")) D
  1.  . . S I="" F CNT=1:1 S I=$O(VBECARY(I)) Q:I=""  D
  1.  . . . S X=VBECARY(I)
  1.  . . . S ^LAB(60,VBIENS(1),8,0)="^60.11PA^"_$P(X,"^",4)_"^"_CNT
  1.  . . . S ^LAB(60,VBIENS(1),8,I,0)=$P(X,"^",4)_"^"_$P(X,"^",3)
  1.  . D MES^XPDUTL("   '"_$P(VBDATA,"^",1)_"' added successfully.")
  1.  . Q
  1.  Q
  1. DIR(LABTST) ; Ask user for Collection Sample for Lab Test
  1.  ;
  1.  S DIR("A")="Select COLLECTION SAMPLE for Lab Test "_LABTST
  1.  S DIR(0)="P^62:EMZ"
  1.  D ^DIR
  1.  Q Y
  1.  ;
  1. XPAR ;Main entry point
  1.  ;
  1.  D BMES^XPDUTL("Adding VBECS VISTALINK PARAMETERS.")
  1.  N VBDATA
  1.  F VBECI=1:1 S VBDATA=$P($T(PARMS+VBECI),";;",2) Q:VBDATA["***"  D
  1.  . D MES^XPDUTL("---Adding '"_VBDATA_"' PARAMETER.")
  1.  . I $$CONTEXT^VBECRPCC(VBDATA,$$ENCRYP^XUSRB1("VBECS RPC Security")) D
  1.  . . D MES^XPDUTL("   ***Error adding '"_VBDATA_"' PARAMETER.***")
  1.  . E  D MES^XPDUTL("   '"_VBDATA_"' PARAMETER added successfully.")
  1.  ; Check Post Install questions and create VistALink IP Address and Port parameters.
  1.  I $D(XPDQUES("POSVLIPADDRESS"))&($D(XPDQUES("POSVLPORT"))) D
  1.  . D MES^XPDUTL("---Adding 'VISTALINK IP ADDRESS' and 'VISTALINK PORT NUMBER' PARAMETERS.")
  1.  . I '$$CHGADPRT^VBECRPCC(XPDQUES("POSVLIPADDRESS"),XPDQUES("POSVLPORT")) D  Q
  1.  . . D MES^XPDUTL("   'VISTALINK IP ADDRESS' and 'VISTALINK PORT NUMBER' PARAMETERS added successfully.")
  1.  . D MES^XPDUTL("   ***Error adding 'VISTALINK IP ADDRESS' and 'VISTALINK PORT NUMBER' PARAMETERS.***")
  1.  Q
  1.  ;
  1. ACNAREA(VBECARY) ; Return Lab Blood Bank Accession Areas
  1.  N CNT
  1.  S (X,CNT)=0
  1.  F  S X=$O(^LRO(68,X)) Q:X'?1N.N  D
  1.  . Q:$P(^LRO(68,X,0),"^",2)'="BB"
  1.  . S DIV=$O(^LRO(68,X,3,0))_","
  1.  . D GETS^DIQ(4,DIV,".01",,"OUT","ERR")
  1.  . S INST=$G(OUT(4,DIV,.01))
  1.  . S CNT=CNT+1 S VBECARY(+DIV)=$P(^LRO(68,X,0),"^")_"^"_INST_"^"_X_"^"_$O(^LRO(68,X,3,0))
  1.  . Q
  1.  Q
  1.  ;
  1. BLDINV ; Add Generic VBECS Blood Inventory for Lab Workload Reporting
  1.  D BMES^XPDUTL("Adding generic VBECS BLOOD INVENTORY")
  1.  N VBECFDA
  1.  I $$FIND1^DIC(65,"","MX","VBECS1","","","ERR") D  Q
  1.  . D MES^XPDUTL("   'VBECS1' BLOOD INVENTORY already exists.")
  1.  D MES^XPDUTL("---Adding 'VBECS1' BLOOD INVENTORY.")
  1.  S VBECFDA(1,65,"+1,",.01)="VBECS1"
  1.  S VBECFDA(1,65,"+1,",.02)="VBECS SYSTEM"
  1.  S VBECFDA(1,65,"+1,",.03)="1.0"
  1.  S VBECFDA(1,65,"+1,",.04)="VBECS PRODUCT"
  1.  S VBECFDA(1,65,"+1,",.05)=$$NOW^XLFDT()
  1.  S VBECFDA(1,65,"+1,",.06)="3100101"
  1.  S VBECFDA(1,65,"+1,",.07)="N/A"
  1.  S VBECFDA(1,65,"+1,",.08)="N/A"
  1.  ; Need to determine primary division
  1.  S VBECFDA(1,65,"+1,",.16)="589"
  1.  S VBECFDA(1,65,"+1,",4.2)=$$NOW^XLFDT()
  1.  D UPDATE^DIE("","VBECFDA(1)","VBIENS","OUT")
  1.  I $D(OUT("DIERR")) D  Q
  1.  . D MES^XPDUTL("   ***Error adding 'VBECS1' BLOOD INVENTORY.***")
  1.  D MES^XPDUTL("   'VBECS1' BLOOD INVENTORY added successfully.")
  1.  Q
  1.  ;
  1. BLDDONOR ; Add Generic VBECS BLOOD DONOR for Lab Workload Reporting
  1.  N VBECFDA
  1.  Q
  1.  ;
  1. DEL ; Delete entries for testing
  1.  N DA,DR,DIE,DIDEL,VBDATA,VBIEN,X
  1.  D FIND^DIC(61,"","","","OTHER","","","","","OUT","ERR")
  1.  I $D(OUT("DILIST",1,1)) D
  1.  . D MES^XPDUTL("Deleting 'OTHER' TOPOGRAPHY FILE Entry")
  1.  . S X=0
  1.  . F I=0:1 S X=$O(OUT("DILIST",1,I)) Q:X=""  D
  1.  . . S DA=OUT("DILIST",2,X),DIE="^LAB(61,",DR=".01///@",DIDEL=61 D ^DIE
  1.  K DA,DR,DIE,DIDEL,VBIEN
  1.  ;
  1.  D FIND^DIC(62,"","","","VBECS - NO SPECIMEN REQUIRED","","","","","OUT","ERR")
  1.  I $D(OUT("DILIST",1,1)) D
  1.  . D MES^XPDUTL("Deleting 'VBECS - NO SPECIMEN REQUIRED' COLLECTION SAMPLE")
  1.  . S X=0
  1.  . F I=0:1 S X=$O(OUT("DILIST",1,I)) Q:X=""  D
  1.  . . S DA=OUT("DILIST",2,X),DIE="^LAB(62,",DR=".01///@",DIDEL=62 D ^DIE
  1.  K DA,DR,DIE,DIDEL,VBIEN
  1.  ;
  1.  S VBIEN=$$FIND1^DIC(65,"","MX","VBECS1","","","ERR")
  1.  I +VBIEN D
  1.  . D MES^XPDUTL("Deleting 'VBECS1' BLOOD DONOR")
  1.  . S DA=VBIEN,DIE="^LRD(65,",DR=".01///@",DIDEL=65 D ^DIE
  1.  K DA,DR,DIE,DIDEL,VBIEN
  1.  ;
  1.  F VBECI=2:1  S VBDATA=$P($T(LST+VBECI),";;",2) K DO Q:$P(VBDATA,"^",1)="***"  D
  1.  . D FIND^DIC(60,"","","",$P(VBDATA,"^",1),"","","","","OUT","ERR")
  1.  . I $D(OUT("DILIST",1,1)) D  Q
  1.  . . D MES^XPDUTL("Deleting '"_$P(VBDATA,"^",1)_"' LABORATORY TEST")
  1.  . . S X=0
  1.  . . F I=0:1 S X=$O(OUT("DILIST",1,I)) Q:X=""  D
  1.  . . . S DA=OUT("DILIST",2,X),DIE="^LAB(60,",DR=".01///@",DIDEL=60 D ^DIE
  1.  Q
  1.  ;
  1. LST ;;NAME^TYPE^HIGHEST URGENCY ALLOWED^PRINT NAME^SUBSCRIPT^COLLECTION SAMPLE^UNIQUE COLLECTION SAMPLE
  1.  ;;.01 ^3   ^17                      ^51        ^4        ^60.03,.01        ^8
  1.  ;;ABO/RH - LAB^O^STAT^ABO RH^BB^^1
  1.  ;;ANTIBODY SCREEN - LAB^O^STAT^AB SCRN^BB^^1
  1.  ;;DIRECT ANTIGLOBULIN TEST - LAB^O^STAT^DAT^BB^^1
  1.  ;;TRANSFUSION REACTION WORKUP - LAB^O^STAT^TRW^BB^^1
  1.  ;;TYPE & SCREEN - LAB^O^STAT^T&S^BB^^1
  1.  ;;CRYOPRECIPITATE - LAB^O^STAT^CRYOPRE^BB^NRQ^1
  1.  ;;FRESH FROZEN PLASMA - LAB^O^STAT^FFP^BB^NRQ^1
  1.  ;;OTHER - LAB^O^STAT^VBOTHER^BB^NRQ^1
  1.  ;;PLATELETS - LAB^O^STAT^PLTLTS^BB^NRQ^1
  1.  ;;RED BLOOD CELLS - LAB^O^STAT^RED BLD^BB^NRQ^1
  1.  ;;WHOLE BLOOD - LAB^O^STAT^WB^BB^NRQ^1
  1.  ;;***^Add new entries above this line
  1.  Q
  1.  ;
  1. PARMS ; Build VBECS PARAMETERS
  1.  ;;VBECS Order Entry
  1.  ;;VBECS Workload
  1.  ;;VBECS Update Workload Event
  1.  ;;VBECS Patient ABO_RH
  1.  ;;VBECS Patient TRRX
  1.  ;;VBECS Patient ABID
  1.  ;;VBECS Patient Available Units
  1.  ;;VBECS Blood Products
  1.  ;;VBECS Patient Transfusion History
  1.  ;;VBECS Patient Report
  1.  ;;VBECS DSS Extract
  1.  ;;***^Add new entries above this line
  1.  Q
  1.  ;
  1. BI ;;UNIT ID^SOURCE^INVOICE#^COMPONENT^DATE/TIME RECEIVED^EXP DATE/TIME^ABO GROUP^RH TYPE^DIVISION^DISP DATE
  1.  ;;.01    ^.02   ^.03     ^.04      ^.05               ^.06          ^.07      ^.08    ^.16     ^4.2
  1.  ;;VBECS GENERIC UNIT^VBECS SYSTEM^1.0^VBECS PRODUCT^^^N/A^N/A^^
  1.  Q