Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGRUDYN

DGRUDYN.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. EN(EVENT) ;
  1. ;
  1. ; Input CLIENT - HL7 Client protocol
  1. ; DGWARD - Ward location [Optional]
  1. ;
  1. N DGENTRY,DGDIV,DGSCN,DGSITE,HLNODE,DGSTN,DGWARD,DGIEN,DGFAC,CLIENT
  1. ;
  1. Q:$G(EVENT)']""
  1. ;
  1. ; Extract HL7 message to local array for processing
  1. N I,J,X
  1. F I=1:1 X HLNEXT Q:HLQUIT'>0 D
  1. . S X(I)=HLNODE,J=0
  1. . F S J=$O(HLNODE(J)) Q:'J S X(I,J)=HLNODE(J)
  1. ;
  1. ; Look for PV1 segment. If A03 or A21, get previous ward, otherwise get current ward location.
  1. S I=0
  1. F S I=$O(X(I)) Q:'I D
  1. . I $P(X(I),"^",1)="PV1" D
  1. . . I "A03"[EVENT S DGWARD=$$WARD(X(I),7)
  1. . . I "A11"[EVENT S DGWARD=$$WARD(X(I),7) ; Retrieve ward prior toadmission cancellation
  1. . . I "A21"[EVENT S DGWARD=$$WARD(X(I),7)
  1. . . I '$G(DGWARD) S DGWARD=$$WARD(X(I),4)
  1. ;
  1. ; Get division for ward
  1. S DGDIV=+$$GET1^DIQ(42,DGWARD,.015,"I")
  1. ;
  1. ; Retrieve subscription control number for division
  1. S DGSCN=+$$GET1^DIQ(40.8,DGDIV,900.01)
  1. ;
  1. ;set HLL("LINKS") array
  1. K HLL ;added p-357
  1. D GET^HLSUB(DGSCN,2,"",.HLL) ;added p-357
  1. ;
  1. ; Set client protocol for destination
  1. S DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV)
  1. Q:'$D(HLL("LINKS",1)) ;Quit if no RAI Number is Medical Center Division - DG*5.3*1053
  1. ; S DGAPIEN=$P(HLL("LINKS",1),"^",4) ;changed p-357, disabled p-501
  1. S DGAPIEN=$$GET1^DIQ(771,$P(HLL("LINKS",1),"^",4),.01) ; added p-501
  1. S DGFAC=$$GET1^DIQ(771,$P(HLL("LINKS",1),"^",4),3) ; added p-501
  1. ; S CLIENT="DGRU-RAI-"_EVENT_"-"_DGAPIEN ;changed p-357,disabled p501
  1. S CLIENT="DGRU-RAI-"_EVENT ; added p-501
  1. S $P(HLL("LINKS",1),"^",1)=CLIENT ;changed p-357
  1. S HLP("SUBSCRIBER")="^^^"_DGAPIEN_"^"_DGFAC ; added p-501
  1. Q
  1. ;
  1. WARD(DGPV1,DGP) ; Retrieve Ward IEN for Division lookup. If the ward has been
  1. ; "translated", then return the original Ward IEN.
  1. ; Input
  1. ; DGPV1 - Copy of the PV1 segment
  1. ; DGP - Piece containing the ward to be checked
  1. ;
  1. N DGW,DGN,Y,DIC,DGIEN,DGX
  1. ;
  1. S DGW=$P(DGPV1,"^",DGP),DGN=$P(DGW,"~",1)
  1. S DGIEN=$$FIND1^DIC(42,"","BX",DGN,"","","DGERR")
  1. ;
  1. ; If the Lookup is unable to find a valid ward location, then check to see if this
  1. ; is a translated ward name. If it is, then return original ward ien
  1. I DGIEN<1 D
  1. . S DGX=$$FIND1^DIC(46.12,"","",DGN,"AC")
  1. . I DGX>0 S DGIEN=+$G(^DGRU(46.12,DGX,0)) ;p-473
  1. . E D ;p-473
  1. .. S DGX=$O(^DGRU(46.12,"AC",DGN,0)) ;p-473
  1. .. I DGX>0 S DGIEN=+$G(^DGRU(46.12,DGX,0)) ;p-473
  1. Q DGIEN
  1. ;
  1. ENMFU(DGEVENT,DGDIV) ;ENTRY POINT FOR MASTER FILE UPDATE ROUTING
  1. ;
  1. N DGAPIEN,DGFAC,CLIENT
  1. S DGSCN=$$GET1^DIQ(40.8,DGDIV,900.01) ;Retrieve the Subscription Control Number for the division
  1. Q:DGSCN']"" ;Quit if division does not have a Subscription Control Number
  1. S DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV) ;Retrieve station info for division
  1. K HLL ;changed p-357
  1. D GET^HLSUB(DGSCN,2,"",.HLL) ;changed p-357
  1. ; S DGAPIEN=$P(HLL("LINKS",1),"^",4) ;ADDED P-357, disabled p-501
  1. S DGAPIEN=$$GET1^DIQ(771,$P(HLL("LINKS",1),"^",4),.01) ; added p-501
  1. S DGFAC=$$GET1^DIQ(771,$P(HLL("LINKS",1),"^",4),3) ; added p-501
  1. ; S CLIENT="DGRU-RAI-"_DGEVENT_"-"_DGAPIEN ;changed p-357 Set client variable using event type and receiving app,disabled p-501
  1. S CLIENT="DGRU-RAI-"_DGEVENT ; added p-501
  1. S $P(HLL("LINKS",1),"^",1)=CLIENT ;added p-357
  1. S HLP("SUBSCRIBER")="^^^"_DGAPIEN_"^"_DGFAC ; added p-501
  1. Q
  1. ;