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