- 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 ;
