DGRUDYN ;ALB/SCK - RAI/MDS COTS DYNAMIC ADDRESSING ROUTINE; 9-2-99 ; 6/23/03 3:25pm
;;5.3;Registration;**190,328,354,357,473,501,1053**;Aug 13, 1993;Build 4
;
EN(EVENT) ;
;
; Input CLIENT - HL7 Client protocol
; DGWARD - Ward location [Optional]
;
N DGENTRY,DGDIV,DGSCN,DGSITE,HLNODE,DGSTN,DGWARD,DGIEN,DGFAC,CLIENT
;
Q:$G(EVENT)']""
;
; Extract HL7 message to local array for processing
N I,J,X
F I=1:1 X HLNEXT Q:HLQUIT'>0 D
. S X(I)=HLNODE,J=0
. F S J=$O(HLNODE(J)) Q:'J S X(I,J)=HLNODE(J)
;
; Look for PV1 segment. If A03 or A21, get previous ward, otherwise get current ward location.
S I=0
F S I=$O(X(I)) Q:'I D
. I $P(X(I),"^",1)="PV1" D
. . I "A03"[EVENT S DGWARD=$$WARD(X(I),7)
. . I "A11"[EVENT S DGWARD=$$WARD(X(I),7) ; Retrieve ward prior toadmission cancellation
. . I "A21"[EVENT S DGWARD=$$WARD(X(I),7)
. . I '$G(DGWARD) S DGWARD=$$WARD(X(I),4)
;
; Get division for ward
S DGDIV=+$$GET1^DIQ(42,DGWARD,.015,"I")
;
; Retrieve subscription control number for division
S DGSCN=+$$GET1^DIQ(40.8,DGDIV,900.01)
;
;set HLL("LINKS") array
K HLL ;added p-357
D GET^HLSUB(DGSCN,2,"",.HLL) ;added p-357
;
; Set client protocol for destination
S DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV)
Q:'$D(HLL("LINKS",1)) ;Quit if no RAI Number is Medical Center Division - DG*5.3*1053
; S DGAPIEN=$P(HLL("LINKS",1),"^",4) ;changed p-357, disabled p-501
S DGAPIEN=$$GET1^DIQ(771,$P(HLL("LINKS",1),"^",4),.01) ; added p-501
S DGFAC=$$GET1^DIQ(771,$P(HLL("LINKS",1),"^",4),3) ; added p-501
; S CLIENT="DGRU-RAI-"_EVENT_"-"_DGAPIEN ;changed p-357,disabled p501
S CLIENT="DGRU-RAI-"_EVENT ; added p-501
S $P(HLL("LINKS",1),"^",1)=CLIENT ;changed p-357
S HLP("SUBSCRIBER")="^^^"_DGAPIEN_"^"_DGFAC ; added p-501
Q
;
WARD(DGPV1,DGP) ; Retrieve Ward IEN for Division lookup. If the ward has been
; "translated", then return the original Ward IEN.
; Input
; DGPV1 - Copy of the PV1 segment
; DGP - Piece containing the ward to be checked
;
N DGW,DGN,Y,DIC,DGIEN,DGX
;
S DGW=$P(DGPV1,"^",DGP),DGN=$P(DGW,"~",1)
S DGIEN=$$FIND1^DIC(42,"","BX",DGN,"","","DGERR")
;
; If the Lookup is unable to find a valid ward location, then check to see if this
; is a translated ward name. If it is, then return original ward ien
I DGIEN<1 D
. S DGX=$$FIND1^DIC(46.12,"","",DGN,"AC")
. I DGX>0 S DGIEN=+$G(^DGRU(46.12,DGX,0)) ;p-473
. E D ;p-473
.. S DGX=$O(^DGRU(46.12,"AC",DGN,0)) ;p-473
.. I DGX>0 S DGIEN=+$G(^DGRU(46.12,DGX,0)) ;p-473
Q DGIEN
;
ENMFU(DGEVENT,DGDIV) ;ENTRY POINT FOR MASTER FILE UPDATE ROUTING
;
N DGAPIEN,DGFAC,CLIENT
S DGSCN=$$GET1^DIQ(40.8,DGDIV,900.01) ;Retrieve the Subscription Control Number for the division
Q:DGSCN']"" ;Quit if division does not have a Subscription Control Number
S DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV) ;Retrieve station info for division
K HLL ;changed p-357
D GET^HLSUB(DGSCN,2,"",.HLL) ;changed p-357
; S DGAPIEN=$P(HLL("LINKS",1),"^",4) ;ADDED P-357, disabled p-501
S DGAPIEN=$$GET1^DIQ(771,$P(HLL("LINKS",1),"^",4),.01) ; added p-501
S DGFAC=$$GET1^DIQ(771,$P(HLL("LINKS",1),"^",4),3) ; added p-501
; S CLIENT="DGRU-RAI-"_DGEVENT_"-"_DGAPIEN ;changed p-357 Set client variable using event type and receiving app,disabled p-501
S CLIENT="DGRU-RAI-"_DGEVENT ; added p-501
S $P(HLL("LINKS",1),"^",1)=CLIENT ;added p-357
S HLP("SUBSCRIBER")="^^^"_DGAPIEN_"^"_DGFAC ; added p-501
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUDYN 3493 printed Oct 16, 2024@18:58:38 Page 2
DGRUDYN ;ALB/SCK - RAI/MDS COTS DYNAMIC ADDRESSING ROUTINE; 9-2-99 ; 6/23/03 3:25pm
+1 ;;5.3;Registration;**190,328,354,357,473,501,1053**;Aug 13, 1993;Build 4
+2 ;
EN(EVENT) ;
+1 ;
+2 ; Input CLIENT - HL7 Client protocol
+3 ; DGWARD - Ward location [Optional]
+4 ;
+5 NEW DGENTRY,DGDIV,DGSCN,DGSITE,HLNODE,DGSTN,DGWARD,DGIEN,DGFAC,CLIENT
+6 ;
+7 if $GET(EVENT)']""
QUIT
+8 ;
+9 ; Extract HL7 message to local array for processing
+10 NEW I,J,X
+11 FOR I=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+12 SET X(I)=HLNODE
SET J=0
+13 FOR
SET J=$ORDER(HLNODE(J))
if 'J
QUIT
SET X(I,J)=HLNODE(J)
End DoDot:1
+14 ;
+15 ; Look for PV1 segment. If A03 or A21, get previous ward, otherwise get current ward location.
+16 SET I=0
+17 FOR
SET I=$ORDER(X(I))
if 'I
QUIT
Begin DoDot:1
+18 IF $PIECE(X(I),"^",1)="PV1"
Begin DoDot:2
+19 IF "A03"[EVENT
SET DGWARD=$$WARD(X(I),7)
+20 ; Retrieve ward prior toadmission cancellation
IF "A11"[EVENT
SET DGWARD=$$WARD(X(I),7)
+21 IF "A21"[EVENT
SET DGWARD=$$WARD(X(I),7)
+22 IF '$GET(DGWARD)
SET DGWARD=$$WARD(X(I),4)
End DoDot:2
End DoDot:1
+23 ;
+24 ; Get division for ward
+25 SET DGDIV=+$$GET1^DIQ(42,DGWARD,.015,"I")
+26 ;
+27 ; Retrieve subscription control number for division
+28 SET DGSCN=+$$GET1^DIQ(40.8,DGDIV,900.01)
+29 ;
+30 ;set HLL("LINKS") array
+31 ;added p-357
KILL HLL
+32 ;added p-357
DO GET^HLSUB(DGSCN,2,"",.HLL)
+33 ;
+34 ; Set client protocol for destination
+35 SET DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV)
+36 ;Quit if no RAI Number is Medical Center Division - DG*5.3*1053
if '$DATA(HLL("LINKS",1))
QUIT
+37 ; S DGAPIEN=$P(HLL("LINKS",1),"^",4) ;changed p-357, disabled p-501
+38 ; added p-501
SET DGAPIEN=$$GET1^DIQ(771,$PIECE(HLL("LINKS",1),"^",4),.01)
+39 ; added p-501
SET DGFAC=$$GET1^DIQ(771,$PIECE(HLL("LINKS",1),"^",4),3)
+40 ; S CLIENT="DGRU-RAI-"_EVENT_"-"_DGAPIEN ;changed p-357,disabled p501
+41 ; added p-501
SET CLIENT="DGRU-RAI-"_EVENT
+42 ;changed p-357
SET $PIECE(HLL("LINKS",1),"^",1)=CLIENT
+43 ; added p-501
SET HLP("SUBSCRIBER")="^^^"_DGAPIEN_"^"_DGFAC
+44 QUIT
+45 ;
WARD(DGPV1,DGP) ; Retrieve Ward IEN for Division lookup. If the ward has been
+1 ; "translated", then return the original Ward IEN.
+2 ; Input
+3 ; DGPV1 - Copy of the PV1 segment
+4 ; DGP - Piece containing the ward to be checked
+5 ;
+6 NEW DGW,DGN,Y,DIC,DGIEN,DGX
+7 ;
+8 SET DGW=$PIECE(DGPV1,"^",DGP)
SET DGN=$PIECE(DGW,"~",1)
+9 SET DGIEN=$$FIND1^DIC(42,"","BX",DGN,"","","DGERR")
+10 ;
+11 ; If the Lookup is unable to find a valid ward location, then check to see if this
+12 ; is a translated ward name. If it is, then return original ward ien
+13 IF DGIEN<1
Begin DoDot:1
+14 SET DGX=$$FIND1^DIC(46.12,"","",DGN,"AC")
+15 ;p-473
IF DGX>0
SET DGIEN=+$GET(^DGRU(46.12,DGX,0))
+16 ;p-473
IF '$TEST
Begin DoDot:2
+17 ;p-473
SET DGX=$ORDER(^DGRU(46.12,"AC",DGN,0))
+18 ;p-473
IF DGX>0
SET DGIEN=+$GET(^DGRU(46.12,DGX,0))
End DoDot:2
End DoDot:1
+19 QUIT DGIEN
+20 ;
ENMFU(DGEVENT,DGDIV) ;ENTRY POINT FOR MASTER FILE UPDATE ROUTING
+1 ;
+2 NEW DGAPIEN,DGFAC,CLIENT
+3 ;Retrieve the Subscription Control Number for the division
SET DGSCN=$$GET1^DIQ(40.8,DGDIV,900.01)
+4 ;Quit if division does not have a Subscription Control Number
if DGSCN']""
QUIT
+5 ;Retrieve station info for division
SET DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV)
+6 ;changed p-357
KILL HLL
+7 ;changed p-357
DO GET^HLSUB(DGSCN,2,"",.HLL)
+8 ; S DGAPIEN=$P(HLL("LINKS",1),"^",4) ;ADDED P-357, disabled p-501
+9 ; added p-501
SET DGAPIEN=$$GET1^DIQ(771,$PIECE(HLL("LINKS",1),"^",4),.01)
+10 ; added p-501
SET DGFAC=$$GET1^DIQ(771,$PIECE(HLL("LINKS",1),"^",4),3)
+11 ; S CLIENT="DGRU-RAI-"_DGEVENT_"-"_DGAPIEN ;changed p-357 Set client variable using event type and receiving app,disabled p-501
+12 ; added p-501
SET CLIENT="DGRU-RAI-"_DGEVENT
+13 ;added p-357
SET $PIECE(HLL("LINKS",1),"^",1)=CLIENT
+14 ; added p-501
SET HLP("SUBSCRIBER")="^^^"_DGAPIEN_"^"_DGFAC
+15 QUIT
+16 ;
