VDEFVU ;BPOIFO/JG - VDEF Application Package Support; ; 21 Dec 2004 11:28 AM
;;1.00;VDEF;;Dec 17, 2004
;Per VHA Directive 2004-038, this routine should not be modified.
;
Q ; No Bozos
;
; KIDS Environment Check API
ENVCHK I $G(XPDENV)="" S ERRMSG="Must be run as a KIDS Environment Check." G KIDSABRT
Q:$T(QUEUE^VDEFQM)'=""
S ERRMSG="VDEF must be installed before this patch." G KIDSABRT
Q
;
; KIDS Post-Install Application API
; Creates application specific entries in files #577 and #579.6
POSTKID(MSGTYP,EVNTYP,SUBTYP,PROTO,CUSTPKG,EXTROUT,EVDESC,SUBDESC,KIDABORT) ;
I $G(XPDNM)="" S ERRMSG="Must be run as a KIDS Post-Install process." G KIDSABRT
;
; Inputs: (All are required except SUBDESC which is only required
; when a new SUBTYP is being passed in)
; MSGTYP - HL7 message type
; EVNTYP - HL7 event type
; SUBTYP - VDEF Event subtype
; PROTO - VistA HL7 Event Driver Protocol Name
; CUSTPKG - Custodial Package Name
; EXTROUT - VDEF Message Extraction Program
; EVDESC - Event description
; SUBDESC - Subtype description if new subtype (optional)
;
; Outputs: None
;
N FDA,ERRMSG,ERR,DATA,VAL,MSGIEN,EVNIEN,CUSTIEN,CUSTIENV,SUBIEN,PROTIEN
N IEN577,FDA,X,NEWSUB
;
; Validate all the inputs
I $G(MSGTYP)="" S ERRMSG="HL7 Message Type missing" G KIDSABRT
I $G(EVNTYP)="" S ERRMSG="HL7 Event Type missing" G KIDSABRT
I $G(SUBTYP)="" S ERRMSG="VDEF event subtype missing" G KIDSABRT
I $G(PROTO)="" S ERRMSG="VistA HL7 Event Driver Protocol missing" G KIDSABRT
I $G(CUSTPKG)="" S ERRMSG="Application's custodial package missing" G KIDSABRT
I $G(EXTROUT)="" S ERRMSG="VDEF message extraction program missing" G KIDSABRT
S X=EXTROUT D RTNVAL^VDEFEL
I $G(X)="" S ERRMSG="Not a valid VDEF message extraction program" G KIDSABRT
I $G(EVDESC)="" S ERRMSG="Event description missing" G KIDSABRT
S MSGIEN=$$FIND1^DIC(771.2,"","BX",MSGTYP)
I 'MSGIEN S ERRMSG="Invalid HL7 Message Type" G KIDSABRT
S EVNIEN=$$FIND1^DIC(779.001,"","BX",EVNTYP)
I 'EVNIEN S ERRMSG="Invalid HL7 Event Type" G KIDSABRT
S SUBIEN=$$FIND1^DIC(577.4,"","BX",SUBTYP),NEWSUB='SUBIEN
I NEWSUB,$G(SUBDESC)="" S ERRMSG="New Subtype requires a description" G KIDSABRT
S PROTIEN=$$FIND1^DIC(101,"","BX",PROTO)
I 'PROTIEN S ERRMSG="Invalid VistA HL7 Protocol" G KIDSABRT
S CUSTIEN=$$FIND1^DIC(9.4,"","BX",CUSTPKG)
I 'CUSTIEN S ERRMSG="Invalid Custodial Package" G KIDSABRT
;
; Add custodial pkg. to VDEF Custodial Package file #579.6 if new
S ERRMSG="",CUSTIENV=$$FIND1^DIC(579.6,"","BX",CUSTPKG)
I CUSTIENV=0 D
. K FDA,ERR
. S FDA(579.6,"+1,",.01)=CUSTIEN,FDA(579.6,"+1,",.02)="I"
. D UPDATE^DIE("","FDA","CUSTIENV","ERR")
. I $G(ERR("DIERR",1))>0 S ERRMSG=ERR("DIERR",1,"TEXT",1)
. S CUSTIENV=CUSTIENV(1) K CUSTIENV(1)
G KIDSABRT:ERRMSG'=""
;
; Add/update VDEF Subtype in File #577.4
S ERRMSG="" K FDA,ERR
S FDA(577.4,"?+1,",.01)=SUBTYP,FDA(577.4,"?+1,",.02)=SUBDESC
D UPDATE^DIE("","FDA","SUBIEN","ERR")
I $G(ERR("DIERR",1))>0 S ERRMSG=ERR("DIERR",1,"TEXT",1)
S SUBIEN=SUBIEN(1) K SUBIEN(1)
G KIDSABRT:ERRMSG'=""
;
; Add the event to the VDEF Event file #577
K FDA,ERR
S FDA(577,"?+1,",.01)=MSGTYP_"-"_EVNTYP_"-"_SUBTYP
S FDA(577,"?+1,",.02)=EVNIEN,FDA(577,"?+1,",.03)=SUBIEN
S FDA(577,"?+1,",.06)=MSGIEN,FDA(577,"?+1,",.07)=PROTIEN
S FDA(577,"?+1,",.09)=CUSTIENV,FDA(577,"?+1,",.2)="I"
S FDA(577,"?+1,",.3)=EXTROUT,FDA(577,"?+1,",1)=EVDESC
D UPDATE^DIE("","FDA","IEN577","ERR")
I $G(ERR("DIERR",1))>0 S ERRMSG=ERR("DIERR",1,"TEXT",1) G KIDSABRT
;
; Successful completion
Q
;
; Post-install abort
KIDSABRT D BMES^XPDUTL(ERRMSG) S (XPDABORT,KIDABORT)=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVDEFVU 3723 printed Apr 09, 2024@21:46:20 Page 2
VDEFVU ;BPOIFO/JG - VDEF Application Package Support; ; 21 Dec 2004 11:28 AM
+1 ;;1.00;VDEF;;Dec 17, 2004
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; No Bozos
QUIT
+5 ;
+6 ; KIDS Environment Check API
ENVCHK IF $GET(XPDENV)=""
SET ERRMSG="Must be run as a KIDS Environment Check."
GOTO KIDSABRT
+1 if $TEXT(QUEUE^VDEFQM)'=""
QUIT
+2 SET ERRMSG="VDEF must be installed before this patch."
GOTO KIDSABRT
+3 QUIT
+4 ;
+5 ; KIDS Post-Install Application API
+6 ; Creates application specific entries in files #577 and #579.6
POSTKID(MSGTYP,EVNTYP,SUBTYP,PROTO,CUSTPKG,EXTROUT,EVDESC,SUBDESC,KIDABORT) ;
+1 IF $GET(XPDNM)=""
SET ERRMSG="Must be run as a KIDS Post-Install process."
GOTO KIDSABRT
+2 ;
+3 ; Inputs: (All are required except SUBDESC which is only required
+4 ; when a new SUBTYP is being passed in)
+5 ; MSGTYP - HL7 message type
+6 ; EVNTYP - HL7 event type
+7 ; SUBTYP - VDEF Event subtype
+8 ; PROTO - VistA HL7 Event Driver Protocol Name
+9 ; CUSTPKG - Custodial Package Name
+10 ; EXTROUT - VDEF Message Extraction Program
+11 ; EVDESC - Event description
+12 ; SUBDESC - Subtype description if new subtype (optional)
+13 ;
+14 ; Outputs: None
+15 ;
+16 NEW FDA,ERRMSG,ERR,DATA,VAL,MSGIEN,EVNIEN,CUSTIEN,CUSTIENV,SUBIEN,PROTIEN
+17 NEW IEN577,FDA,X,NEWSUB
+18 ;
+19 ; Validate all the inputs
+20 IF $GET(MSGTYP)=""
SET ERRMSG="HL7 Message Type missing"
GOTO KIDSABRT
+21 IF $GET(EVNTYP)=""
SET ERRMSG="HL7 Event Type missing"
GOTO KIDSABRT
+22 IF $GET(SUBTYP)=""
SET ERRMSG="VDEF event subtype missing"
GOTO KIDSABRT
+23 IF $GET(PROTO)=""
SET ERRMSG="VistA HL7 Event Driver Protocol missing"
GOTO KIDSABRT
+24 IF $GET(CUSTPKG)=""
SET ERRMSG="Application's custodial package missing"
GOTO KIDSABRT
+25 IF $GET(EXTROUT)=""
SET ERRMSG="VDEF message extraction program missing"
GOTO KIDSABRT
+26 SET X=EXTROUT
DO RTNVAL^VDEFEL
+27 IF $GET(X)=""
SET ERRMSG="Not a valid VDEF message extraction program"
GOTO KIDSABRT
+28 IF $GET(EVDESC)=""
SET ERRMSG="Event description missing"
GOTO KIDSABRT
+29 SET MSGIEN=$$FIND1^DIC(771.2,"","BX",MSGTYP)
+30 IF 'MSGIEN
SET ERRMSG="Invalid HL7 Message Type"
GOTO KIDSABRT
+31 SET EVNIEN=$$FIND1^DIC(779.001,"","BX",EVNTYP)
+32 IF 'EVNIEN
SET ERRMSG="Invalid HL7 Event Type"
GOTO KIDSABRT
+33 SET SUBIEN=$$FIND1^DIC(577.4,"","BX",SUBTYP)
SET NEWSUB='SUBIEN
+34 IF NEWSUB
IF $GET(SUBDESC)=""
SET ERRMSG="New Subtype requires a description"
GOTO KIDSABRT
+35 SET PROTIEN=$$FIND1^DIC(101,"","BX",PROTO)
+36 IF 'PROTIEN
SET ERRMSG="Invalid VistA HL7 Protocol"
GOTO KIDSABRT
+37 SET CUSTIEN=$$FIND1^DIC(9.4,"","BX",CUSTPKG)
+38 IF 'CUSTIEN
SET ERRMSG="Invalid Custodial Package"
GOTO KIDSABRT
+39 ;
+40 ; Add custodial pkg. to VDEF Custodial Package file #579.6 if new
+41 SET ERRMSG=""
SET CUSTIENV=$$FIND1^DIC(579.6,"","BX",CUSTPKG)
+42 IF CUSTIENV=0
Begin DoDot:1
+43 KILL FDA,ERR
+44 SET FDA(579.6,"+1,",.01)=CUSTIEN
SET FDA(579.6,"+1,",.02)="I"
+45 DO UPDATE^DIE("","FDA","CUSTIENV","ERR")
+46 IF $GET(ERR("DIERR",1))>0
SET ERRMSG=ERR("DIERR",1,"TEXT",1)
+47 SET CUSTIENV=CUSTIENV(1)
KILL CUSTIENV(1)
End DoDot:1
+48 if ERRMSG'=""
GOTO KIDSABRT
+49 ;
+50 ; Add/update VDEF Subtype in File #577.4
+51 SET ERRMSG=""
KILL FDA,ERR
+52 SET FDA(577.4,"?+1,",.01)=SUBTYP
SET FDA(577.4,"?+1,",.02)=SUBDESC
+53 DO UPDATE^DIE("","FDA","SUBIEN","ERR")
+54 IF $GET(ERR("DIERR",1))>0
SET ERRMSG=ERR("DIERR",1,"TEXT",1)
+55 SET SUBIEN=SUBIEN(1)
KILL SUBIEN(1)
+56 if ERRMSG'=""
GOTO KIDSABRT
+57 ;
+58 ; Add the event to the VDEF Event file #577
+59 KILL FDA,ERR
+60 SET FDA(577,"?+1,",.01)=MSGTYP_"-"_EVNTYP_"-"_SUBTYP
+61 SET FDA(577,"?+1,",.02)=EVNIEN
SET FDA(577,"?+1,",.03)=SUBIEN
+62 SET FDA(577,"?+1,",.06)=MSGIEN
SET FDA(577,"?+1,",.07)=PROTIEN
+63 SET FDA(577,"?+1,",.09)=CUSTIENV
SET FDA(577,"?+1,",.2)="I"
+64 SET FDA(577,"?+1,",.3)=EXTROUT
SET FDA(577,"?+1,",1)=EVDESC
+65 DO UPDATE^DIE("","FDA","IEN577","ERR")
+66 IF $GET(ERR("DIERR",1))>0
SET ERRMSG=ERR("DIERR",1,"TEXT",1)
GOTO KIDSABRT
+67 ;
+68 ; Successful completion
+69 QUIT
+70 ;
+71 ; Post-install abort
KIDSABRT DO BMES^XPDUTL(ERRMSG)
SET (XPDABORT,KIDABORT)=1
+1 QUIT
