source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRUDYN.m@ 1318

Last change on this file since 1318 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1DGRUDYN ;ALB/SCK - RAI/MDS COTS DYNAMIC ADDRESSING ROUTINE; 9-2-99 ; 6/23/03 3:25pm
2 ;;5.3;Registration;**190,328,354,357,473,501**;Aug 13, 1993
3 ;
4EN(EVENT) ;
5 ;
6 ; Input CLIENT - HL7 Client protocol
7 ; DGWARD - Ward location [Optional]
8 ;
9 N DGENTRY,DGDIV,DGSCN,DGSITE,HLNODE,DGSTN,DGWARD,DGIEN,DGFAC,CLIENT
10 ;
11 Q:$G(EVENT)']""
12 ;
13 ; Extract HL7 message to local array for processing
14 N I,J,X
15 F I=1:1 X HLNEXT Q:HLQUIT'>0 D
16 . S X(I)=HLNODE,J=0
17 . F S J=$O(HLNODE(J)) Q:'J S X(I,J)=HLNODE(J)
18 ;
19 ; Look for PV1 segment. If A03 or A21, get previous ward, otherwise get current ward location.
20 S I=0
21 F S I=$O(X(I)) Q:'I D
22 . I $P(X(I),"^",1)="PV1" D
23 . . I "A03"[EVENT S DGWARD=$$WARD(X(I),7)
24 . . I "A11"[EVENT S DGWARD=$$WARD(X(I),7) ; Retrieve ward prior toadmission cancellation
25 . . I "A21"[EVENT S DGWARD=$$WARD(X(I),7)
26 . . I '$G(DGWARD) S DGWARD=$$WARD(X(I),4)
27 ;
28 ; Get division for ward
29 S DGDIV=+$$GET1^DIQ(42,DGWARD,.015,"I")
30 ;
31 ; Retrieve subscription control number for division
32 S DGSCN=+$$GET1^DIQ(40.8,DGDIV,900.01)
33 ;
34 ;set HLL("LINKS") array
35 K HLL ;added p-357
36 D GET^HLSUB(DGSCN,2,"",.HLL) ;added p-357
37 ;
38 ; Set client protocol for destination
39 S DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV)
40 ; S DGAPIEN=$P(HLL("LINKS",1),"^",4) ;changed p-357, disabled p-501
41 S DGAPIEN=$$GET1^DIQ(771,$P(HLL("LINKS",1),"^",4),.01) ; added p-501
42 S DGFAC=$$GET1^DIQ(771,$P(HLL("LINKS",1),"^",4),3) ; added p-501
43 ; S CLIENT="DGRU-RAI-"_EVENT_"-"_DGAPIEN ;changed p-357,disabled p501
44 S CLIENT="DGRU-RAI-"_EVENT ; added p-501
45 S $P(HLL("LINKS",1),"^",1)=CLIENT ;changed p-357
46 S HLP("SUBSCRIBER")="^^^"_DGAPIEN_"^"_DGFAC ; added p-501
47 Q
48 ;
49WARD(DGPV1,DGP) ; Retrieve Ward IEN for Division lookup. If the ward has been
50 ; "translated", then return the original Ward IEN.
51 ; Input
52 ; DGPV1 - Copy of the PV1 segment
53 ; DGP - Piece containing the ward to be checked
54 ;
55 N DGW,DGN,Y,DIC,DGIEN,DGX
56 ;
57 S DGW=$P(DGPV1,"^",DGP),DGN=$P(DGW,"~",1)
58 S DGIEN=$$FIND1^DIC(42,"","BX",DGN,"","","DGERR")
59 ;
60 ; If the Lookup is unable to find a valid ward location, then check to see if this
61 ; is a translated ward name. If it is, then return original ward ien
62 I DGIEN<1 D
63 . S DGX=$$FIND1^DIC(46.12,"","",DGN,"AC")
64 . I DGX>0 S DGIEN=+$G(^DGRU(46.12,DGX,0)) ;p-473
65 . E D ;p-473
66 .. S DGX=$O(^DGRU(46.12,"AC",DGN,0)) ;p-473
67 .. I DGX>0 S DGIEN=+$G(^DGRU(46.12,DGX,0)) ;p-473
68 Q DGIEN
69 ;
70ENMFU(DGEVENT,DGDIV) ;ENTRY POINT FOR MASTER FILE UPDATE ROUTING
71 ;
72 N DGAPIEN,DGFAC,CLIENT
73 S DGSCN=$$GET1^DIQ(40.8,DGDIV,900.01) ;Retrieve the Subscription Control Number for the division
74 Q:DGSCN']"" ;Quit if division does not have a Subscription Control Number
75 S DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV) ;Retrieve station info for division
76 K HLL ;changed p-357
77 D GET^HLSUB(DGSCN,2,"",.HLL) ;changed p-357
78 ; S DGAPIEN=$P(HLL("LINKS",1),"^",4) ;ADDED P-357, disabled p-501
79 S DGAPIEN=$$GET1^DIQ(771,$P(HLL("LINKS",1),"^",4),.01) ; added p-501
80 S DGFAC=$$GET1^DIQ(771,$P(HLL("LINKS",1),"^",4),3) ; added p-501
81 ; S CLIENT="DGRU-RAI-"_DGEVENT_"-"_DGAPIEN ;changed p-357 Set client variable using event type and receiving app,disabled p-501
82 S CLIENT="DGRU-RAI-"_DGEVENT ; added p-501
83 S $P(HLL("LINKS",1),"^",1)=CLIENT ;added p-357
84 S HLP("SUBSCRIBER")="^^^"_DGAPIEN_"^"_DGFAC ; added p-501
85 Q
86 ;
Note: See TracBrowser for help on using the repository browser.