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

DGQEPST1.m

Go to the documentation of this file. 
  1. DGQEPST1 ;ALB/JFP- VIC POST INIT UTILITIES; 09/01/96
  1.  ;;5.3;REGISTRATION;**73,1015**;DEC 11,1996;Build 21
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. APPUPD ;Updates HL7 Application parameter file (#771) with site #
  1.  ;
  1.  ;Input  : None
  1.  ;Output : None
  1.  ;Note   : This is a KIDS complient check point
  1.  ;
  1.  ;Declare variables
  1.  N FACNUM,DA,DIR,DIE,MSGTXT
  1.  D BMES^XPDUTL(">>> Updates entry DGQE VIC EVENTS in HL APPLICATION file (#771)")
  1.  ;-- Check for application
  1.  I '$D(^HL(771,"B","DGQE VIC EVENTS")) D  Q
  1.  .S MSGTXT(1)="    ** Entries for 'DGQE VIC EVENTS' in the HL APPLICATION"
  1.  .S MSGTXT(2)="       file (#771) can not be created"
  1.  .S MSGTXT(3)="    ** Entries must be manually entered"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  .K MSGTXT
  1.  ;
  1.  S DA="",DA=+$O(^HL(771,"B","DGQE VIC EVENTS",DA))
  1.  S FACNUM=+$P($$SITE^VASITE(),"^",3)
  1.  S DIE="^HL(771,"
  1.  S DR="3///"_FACNUM
  1.  D ^DIE
  1.  S MSGTXT(1)=" "
  1.  S MSGTXT(2)="     DGQE VIC EVENTS updated with site number"
  1.  D MES^XPDUTL(.MSGTXT)
  1.  K MSGTXT
  1.  Q
  1.  ;
  1. UPDLL ;Updates logical link with device,  HL LOWER LEVEL PROTOCOL PARAMETERS
  1.  ;file (#869.2)
  1.  ;
  1.  ;Input  : None
  1.  ;Output : None
  1.  ;Note   : This is a KIDS complient check point
  1.  ;
  1.  ;Declare variables
  1.  N FACNUM,DA,DIR,DIE,MSGTXT,FIND
  1.  D BMES^XPDUTL(">>> Updates entry 'VIC-LINK' in HL LOWER LEVEL PROTOCOL PARAMETER")
  1.  D MES^XPDUTL("    file (#869.2) with device 'VIC CARD'")
  1.  ;-- Check for device
  1.  S FIND=$$FIND1^DIC(3.5,"","X","VIC CARD")
  1.  I FIND=0 D  Q
  1.  .S MSGTXT(1)="    ** Entry for 'VIC CARD' in DEVICE file does not exist"
  1.  .S MSGTXT(2)=""
  1.  .S MSGTXT(3)="    ** The 'VIC CARD' device needs to exist before it can"
  1.  .S MSGTXT(4)="       be updated to the logical link.  These entries"
  1.  .S MSGTXT(5)="       will need to be built manually"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  .K MSGTXT
  1.  ;
  1.  ;-- Check for Locial Link
  1.  S DA=$$FIND1^DIC(869.2,"","X","VIC-LINK")
  1.  I DA=0 D  Q
  1.  .S MSGTXT(1)="    ** Entry for 'VIC-LINK' in the HL LOWER LEVEL PARAMETER"
  1.  .S MSGTXT(2)="       file (#869.2) is not found"
  1.  .S MSGTXT(3)="    ** Entries must be manually entered and updated with"
  1.  .S MSGTXT(4)="       'VIC CARD' device"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  .K MSGTXT
  1.  ;
  1.  S DIE="^HLCS(869.2,"
  1.  S DR="200.01///VIC CARD"
  1.  D ^DIE
  1.  S MSGTXT(1)=" "
  1.  S MSGTXT(2)="    Logical link 'VIC-LINK' updated with device 'VIC CARD'"
  1.  D MES^XPDUTL(.MSGTXT)
  1.  K MSGTXT
  1.  Q
  1.  ;
  1. UPDBULL ;Updates BULLETIN file (#3.6) with mail group VIC
  1.  ;
  1.  ;Input  : None
  1.  ;Output : None
  1.  ;Note   : This is a KIDS complient check point
  1.  ;
  1.  ;Declare variables
  1.  N FACNUM,DA,DIR,DIE,MSGTXT
  1.  D BMES^XPDUTL(">>> Updates entry 'DGQE PHOTO CAPTURE' bulletin with VIC mail group")
  1.  ;-- Check for mail group
  1.  S X=$$FIND1^DIC(3.8,"","X","VIC")
  1.  I X=0 D  Q
  1.  .S MSGTXT(1)="    ** Entry for 'VIC' in MAIL GROUP file does not exist"
  1.  .S MSGTXT(2)=""
  1.  .S MSGTXT(3)="    ** The 'VIC' mail group needs to exist before it can"
  1.  .S MSGTXT(4)="       be updated to the bulletin file.  These entries"
  1.  .S MSGTXT(5)="       will need to be built manually"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  .K MSGTXT
  1.  ;
  1.  ;-- Check for bulletin
  1.  S DA(1)=$$FIND1^DIC(3.6,"","X","DGQE PHOTO CAPTURE")
  1.  I DA(1)=0 D  Q
  1.  .S MSGTXT(1)="    ** Entry for 'DGQE PHOTO CAPTURE' in the bulletin"
  1.  .S MSGTXT(2)="       file (#3.6) is not found"
  1.  .S MSGTXT(3)="    ** The entry must be manually entered and updated"
  1.  .S MSGTXT(4)="       'VIC' mail group"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  .K MSGTXT
  1.  ;
  1.  S DIC="^XMB(3.6,"_DA(1)_",2,"
  1.  S DIC("P")=$P(^DD(3.6,4,0),"^",2)
  1.  S DIC(0)="L"
  1.  K DO,DD
  1.  I X,'$$FIND1^DIC(3.62,","_DA(1)_",","Q",X) D FILE^DICN K DO,DD
  1.  S MSGTXT(1)=" "
  1.  S MSGTXT(2)="    VIC mail group associated DGQE PHOTO CAPTURE bulletin"
  1.  D MES^XPDUTL(.MSGTXT)
  1.  K MSGTXT
  1.  Q
  1.  ;
  1. MAILMEM ; -- A message to adds mail group members to VIC mail group
  1.  ;INPUT  :  None
  1.  ;OUTPUT :  None
  1.  ;Note   : - This is a KID complient check point
  1.  ;
  1.  ; -- Declare variables
  1.  N DA,DIR,DIE,MSGTXT
  1.  D BMES^XPDUTL(">>> Updates VIC mail group with one member")
  1.  ;-- Check for mail group
  1.  S DA(1)=$$FIND1^DIC(3.8,"","X","VIC")
  1.  I DA(1)=0 D  Q
  1.  .S MSGTXT(1)="    ** Entry for 'VIC' mail group can not be found"
  1.  .S MSGTXT(2)="    ** The VIC mail group and members will need to be"
  1.  .S MSGTXT(3)="       entered manually"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  .K MSGTXT
  1.  ;
  1.  ;-- Check for member
  1.  I '$D(XPDQUES("POS1","B")) D  Q
  1.  .S MSGTXT(1)="    ** No member added to VIC mail group."
  1.  .S MSGTXT(2)="    ** Members will need to be entered manually"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  .K MSGTXT
  1.  ;
  1.  S DIC="^XMB(3.8,"_DA(1)_",1,"
  1.  S DIC("P")=$P(^DD(3.8,2,0),"^",2)
  1.  S DIC(0)="L"
  1.  S X=$P($G(XPDQUES("POS1","B")),"^",1) K DO,DD
  1.  I X,'$$FIND1^DIC(3.81,","_DA(1)_",","Q",X) D FILE^DICN K DO,DD
  1.  ;
  1.  S MSGTXT(1)=" "
  1.  S MSGTXT(2)="     VIC mail group updated with new member"
  1.  D MES^XPDUTL(.MSGTXT)
  1.  K MSGTXT
  1.  ;
  1.  D BMES^XPDUTL(">>> Additional members should be added to the VIC Mail Group...")
  1.  S MSGTXT(1)="     The members in this group would be those people"
  1.  S MSGTXT(2)="     responsible for taking care of problems associated"
  1.  S MSGTXT(3)="     with the VIC interface"
  1.  D MES^XPDUTL(.MSGTXT)
  1.  K MSGTXT
  1.  Q
  1.  ;
  1. CHKVER ; Check for version 2.2 in HL7 VERSION file (#771.5)
  1.  ;
  1.  ;Input  : None
  1.  ;Output : None
  1.  ;Note   : This is a KIDS complient check point
  1.  ;
  1.  ;Declare variables
  1.  N X,Y,DIC,MSGTXT,DIE,DR,DA
  1.  D BMES^XPDUTL(">>> Checks for version 2.2 in HL7 VERSION file (#771.5)")
  1.  ;-- Check for version 2.2
  1.  I $D(^HL(771.5,"B",2.2)) D  Q
  1.  .S MSGTXT(1)=" "
  1.  .S MSGTXT(2)="    ** Version 2.2 exist in the HL7 version file (#771.5)"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  .K MSGTXT
  1.  ; -- DIC to add entry
  1.  S DIC(0)="LX"
  1.  S DIC="^HL(771.5,"
  1.  S X=2.2
  1.  D ^DIC
  1.  I Y=-1 D  Q
  1.  .S MSGTXT(1)="    ** Entry for version 2.2 in the HL7 version file "
  1.  .S MSGTXT(2)="       (#771.5) can not be created"
  1.  .S MSGTXT(3)="    ** Entry must be manually entered"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  .K MSGTXT
  1.  ; -- Entry created, update remaining field
  1.  S DA=$P(Y,"^",1)
  1.  S DIE="^HL(771.5,"
  1.  S DR="2///HEALTH LEVEL SEVEN"
  1.  D ^DIE
  1.  S MSGTXT(1)=" "
  1.  S MSGTXT(2)="     Version 2.2 added to file #771.5"
  1.  D MES^XPDUTL(.MSGTXT)
  1.  K MSGTXT
  1.  Q
  1.  ;
  1. CHKA08 ;Checks for version 2.2 in entry A08 of file HL7 EVENT TYPE CODE file
  1.  ;(#779.001)
  1.  ;
  1.  ;Input  : None
  1.  ;Output : None
  1.  ;Note   : This is a KIDS complient check point
  1.  ;
  1.  ;Declare variables
  1.  N DA,DIR,DIE,MSGTXT
  1.  D BMES^XPDUTL(">>> Check for version 2.2 in entry A08 in file #779.001")
  1.  ;-- Check for A08 entry
  1.  I '$D(^HL(779.001,"B","A08")) D  Q
  1.  .S MSGTXT(1)="    ** Entry for 'A08' in HL7 EVENT TYPE CODE file does "
  1.  .S MSGTXT(2)="       not exist"
  1.  .S MSGTXT(3)=""
  1.  .S MSGTXT(4)="    ** The 'A08' event type will need to exist before it"
  1.  .S MSGTXT(5)="       can be updated with version 2.2.  The A08 entry"
  1.  .S MSGTXT(6)="       will need to be built manually and updated"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  .K MSGTXT
  1.  ;
  1.  ;Check for version 2.2 in A08 entry
  1.  ; -- get pointer from 771.5 for version 2.2
  1.  S DA="",DA=$O(^HL(771.5,"B","2.2",DA))
  1.  ; -- get ien for A08
  1.  S DA(1)="",DA(1)=$O(^HL(779.001,"B","A08",DA(1)))
  1.  ; -- check for AO8 entry; for version 2.2
  1.  I $D(^HL(779.001,DA(1),1,"B",DA)) D  Q
  1.  .S MSGTXT(1)=" "
  1.  .S MSGTXT(2)="    ** Version 2.2 already associated with A08 entry"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  .K MSGTXT
  1.  ;
  1.  ; -- Entry Doesn't exist, add it
  1.  S DIC="^HL(779.001,"_DA(1)_",1,"
  1.  S DIC("P")=$P(^DD(779.001,100,0),"^",2)
  1.  S DIC(0)="L"
  1.  S X=DA
  1.  I X,'$D(^HL(779.001,DA(1),1,"B",X)) D FILE^DICN K DO,DD
  1.  S MSGTXT(1)=" "
  1.  S MSGTXT(2)="    Version 2.2 added to entry A08 "
  1.  D MES^XPDUTL(.MSGTXT)
  1.  K MSGTXT
  1.  Q
  1.  ;
  1. CHKACK ;Checks for version 2.2 in entry ACK of file HL7 MESSAGE TYPE file
  1.  ;(#771.2)
  1.  ;
  1.  ;Input  : None
  1.  ;Output : None
  1.  ;Note   : This is a KIDS complient check point
  1.  ;
  1.  ;Declare variables
  1.  N DA,DIR,DIE,MSGTXT
  1.  D BMES^XPDUTL(">>> Check for version 2.2 in entry ACK in file #771.2")
  1.  ;-- Check for ACK entry
  1.  I '$D(^HL(771.2,"B","ACK")) D  Q
  1.  .S MSGTXT(1)="    ** Entry for 'ACK' in HL7 MESSAGE TYPE file does "
  1.  .S MSGTXT(2)="       not exist"
  1.  .S MSGTXT(3)=""
  1.  .S MSGTXT(4)="    ** The 'ACK' message type will need to exist before it"
  1.  .S MSGTXT(5)="       can be updated with version 2.2.  The ACK entry"
  1.  .S MSGTXT(6)="       will need to be built manually and updated"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  .K MSGTXT
  1.  ;
  1.  ;Check for version 2.2 in ACK entry
  1.  ; -- get pointer from 771.5 for version 2.2
  1.  S DA="",DA=$O(^HL(771.5,"B","2.2",DA))
  1.  ; -- get ien for ACK
  1.  S DA(1)="",DA(1)=$O(^HL(771.2,"B","ACK",DA(1)))
  1.  ; -- check for ACK entry; for version 2.2
  1.  I $D(^HL(771.2,DA(1),"V","B",DA)) D  Q
  1.  .S MSGTXT(1)=" "
  1.  .S MSGTXT(2)="    ** Version 2.2 already associated with ACK entry"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  .K MSGTXT
  1.  ;
  1.  ; -- Entry Doesn't exist, add it
  1.  S DIC="^HL(771.2,"_DA(1)_",""V"","
  1.  S DIC("P")=$P(^DD(771.2,3,0),"^",2)
  1.  S DIC(0)="L"
  1.  S X=DA
  1.  I X,'$D(^HL(771.2,DA(1),"V","B",X)) D FILE^DICN K DO,DD
  1.  S MSGTXT(1)=" "
  1.  S MSGTXT(2)="    Version 2.2 added to entry ACK "
  1.  D MES^XPDUTL(.MSGTXT)
  1.  K MSGTXT
  1.  Q
  1.  ;
  1. ALLP ; -- Sets ALLP xref in file 870 for VIC entry
  1.  ;Input  : None
  1.  ;Output : None
  1.  ;Note   : This is a KIDS complient check point
  1.  ;
  1.  S DA=$$FIND1^DIC(870,"","X","VIC")
  1.  S DIK="^HLCS(870,"
  1.  D IX^DIK
  1.  K DA,DIK
  1.  Q
  1.  ; 
  1.  ; -- Done
  1.  Q