DGQEHL74 ;ALB/JFP - VIC Utilities for ADT/TRANSMISSION FILE #39.4; 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.
;
FILE(MID,PAT,CLERK,OPT,SAPPL) ; Entry Point
;Creates entry in ADT/HL7 TRANSMISSION file
;Input(s):
; MID - control ID of MSH segment
; PAT - DFN of patient
; CLERK - transmitted by clerk
; OPT - DHCP option
; SAPPL - sending application
;
;Output:
; 0 - OK
; -1^error text
;
; -- check input
Q:'$D(MID) "-1^ message ID required for filer function"
Q:'$D(PAT) "-1^ patient's DFN required for filer function"
Q:'$D(CLERK) "-1^ clerk required for filer function"
Q:'$D(OPT) "-1^ option required for filer function"
Q:'$D(SAPPL) "-1^ sending application required for filer function"
;
; -- Create entry in ADT/HL7 TRANSMISSION file (#39.4)
N X,DIC,DA,Y
;
S X=MID
S DIC="^VAT(39.4,",DIC(0)="L",DLAYGO=39.4
D ^DIC K DIC,X,DLAYG0
Q:Y<0 "-1^Error filing entry in ^VAT(39.4 - "_X
S DA=+Y
;
; -- update ADT/HL7 TRANSMISSION file (39.4) with remaining fields
N DIE,DR
;
S DIE="^VAT(39.4,"
S DR=".02///"_DT_";.03////"_PAT_";.04///"_CLERK_";.05///"_OPT_";.06///"_SAPPL_";.07///0"
D ^DIE K DIE,DR
QUIT 0
;
REJ(MID,STATUS,REASON) ; Entry Point
; Updates entry in (#39.4) with rejected acknowledgement
; Input(s):
; MID - control ID of MSH segment
; STATUS - status of transmission
; REASON - reason releated to status of transmission
;
; Output:
; 0 - OK
; -1^error text
;
; -- check input
Q:'$D(MID) "-1^ message ID required for update function"
Q:'$D(STATUS) "-1^ status required for update function"
Q:'$D(REASON) "-1^ reason required for update function"
Q:STATUS'=1 "-1^ status needs to be one"
; -- update ADT/HL7 TRANSMISSION file (39.4) with remaining fields
N DIE,DR,DA
;
S DIE="^VAT(39.4,"
S DA=$O(^VAT(39.4,"B",MID,0))
Q:DA="" "-1^Message ID not found in file"
S DR=".07///"_STATUS_";.08///"_REASON
D ^DIE K DIE,DR
QUIT 0
Q
;
DEL(MID) ; Entry Point
; Deletes entry from ADT/HL7 Transmission file (#39.4)
; Input:
; MID - control ID of MSH segment
; Output:
; 0 - OK
; -1^error text
;
; -- Check input
Q:'$D(MID) "-1^message control ID required for delete function"
; -- Delete entry in ADT/HL7 TRANSMISSION file
N DIK,DA
;
S DIK="^VAT(39.4,"
S DA=$O(^VAT(39.4,"B",MID,0))
Q:DA="" "-1^Message ID not found in file"
D ^DIK
; -- Make sure entry deleted
Q:('$D(^VAT(39.4,DA,0))) 0
Q "-1^Message ID "_DA_" not deleted from 39.4"
;
END ;END OF CODE
QUIT
;
DGQEHL74 ;ALB/JFP - VIC Utilities for ADT/TRANSMISSION FILE #39.4; 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 ;
FILE(MID,PAT,CLERK,OPT,SAPPL) ; Entry Point
+1 ;Creates entry in ADT/HL7 TRANSMISSION file
+2 ;Input(s):
+3 ; MID - control ID of MSH segment
+4 ; PAT - DFN of patient
+5 ; CLERK - transmitted by clerk
+6 ; OPT - DHCP option
+7 ; SAPPL - sending application
+8 ;
+9 ;Output:
+10 ; 0 - OK
+11 ; -1^error text
+12 ;
+13 ; -- check input
+14 IF '$DATA(MID)
QUIT "-1^ message ID required for filer function"
+15 IF '$DATA(PAT)
QUIT "-1^ patient's DFN required for filer function"
+16 IF '$DATA(CLERK)
QUIT "-1^ clerk required for filer function"
+17 IF '$DATA(OPT)
QUIT "-1^ option required for filer function"
+18 IF '$DATA(SAPPL)
QUIT "-1^ sending application required for filer function"
+19 ;
+20 ; -- Create entry in ADT/HL7 TRANSMISSION file (#39.4)
+21 NEW X,DIC,DA,Y
+22 ;
+23 SET X=MID
+24 SET DIC="^VAT(39.4,"
SET DIC(0)="L"
SET DLAYGO=39.4
+25 DO ^DIC
KILL DIC,X,DLAYG0
+26 IF Y<0
QUIT "-1^Error filing entry in ^VAT(39.4 - "_X
+27 SET DA=+Y
+28 ;
+29 ; -- update ADT/HL7 TRANSMISSION file (39.4) with remaining fields
+30 NEW DIE,DR
+31 ;
+32 SET DIE="^VAT(39.4,"
+33 SET DR=".02///"_DT_";.03////"_PAT_";.04///"_CLERK_";.05///"_OPT_";.06///"_SAPPL_";.07///0"
+34 DO ^DIE
KILL DIE,DR
+35 QUIT 0
+36 ;
REJ(MID,STATUS,REASON) ; Entry Point
+1 ; Updates entry in (#39.4) with rejected acknowledgement
+2 ; Input(s):
+3 ; MID - control ID of MSH segment
+4 ; STATUS - status of transmission
+5 ; REASON - reason releated to status of transmission
+6 ;
+7 ; Output:
+8 ; 0 - OK
+9 ; -1^error text
+10 ;
+11 ; -- check input
+12 IF '$DATA(MID)
QUIT "-1^ message ID required for update function"
+13 IF '$DATA(STATUS)
QUIT "-1^ status required for update function"
+14 IF '$DATA(REASON)
QUIT "-1^ reason required for update function"
+15 IF STATUS'=1
QUIT "-1^ status needs to be one"
+16 ; -- update ADT/HL7 TRANSMISSION file (39.4) with remaining fields
+17 NEW DIE,DR,DA
+18 ;
+19 SET DIE="^VAT(39.4,"
+20 SET DA=$ORDER(^VAT(39.4,"B",MID,0))
+21 IF DA=""
QUIT "-1^Message ID not found in file"
+22 SET DR=".07///"_STATUS_";.08///"_REASON
+23 DO ^DIE
KILL DIE,DR
+24 QUIT 0
+25 QUIT
+26 ;
DEL(MID) ; Entry Point
+1 ; Deletes entry from ADT/HL7 Transmission file (#39.4)
+2 ; Input:
+3 ; MID - control ID of MSH segment
+4 ; Output:
+5 ; 0 - OK
+6 ; -1^error text
+7 ;
+8 ; -- Check input
+9 IF '$DATA(MID)
QUIT "-1^message control ID required for delete function"
+10 ; -- Delete entry in ADT/HL7 TRANSMISSION file
+11 NEW DIK,DA
+12 ;
+13 SET DIK="^VAT(39.4,"
+14 SET DA=$ORDER(^VAT(39.4,"B",MID,0))
+15 IF DA=""
QUIT "-1^Message ID not found in file"
+16 DO ^DIK
+17 ; -- Make sure entry deleted
+18 IF ('$DATA(^VAT(39.4,DA,0)))
QUIT 0
+19 QUIT "-1^Message ID "_DA_" not deleted from 39.4"
+20 ;
END ;END OF CODE
+1 QUIT
+2 ;
