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