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