- 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 Jan 18, 2025@03:58:46 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 ;