Released DG*5.3*501 SEQ #453 Extracted from mail message **KIDS**:DG*5.3*501^ **INSTALL NAME** DG*5.3*501 "BLD",2982,0) DG*5.3*501^REGISTRATION^0^3030623^y "BLD",2982,4,0) ^9.64PA^^ "BLD",2982,"ABPKG") n "BLD",2982,"INID") ^ "BLD",2982,"INIT") "BLD",2982,"KRN",0) ^9.67PA^8989.52^19 "BLD",2982,"KRN",.4,0) .4 "BLD",2982,"KRN",.401,0) .401 "BLD",2982,"KRN",.402,0) .402 "BLD",2982,"KRN",.403,0) .403 "BLD",2982,"KRN",.5,0) .5 "BLD",2982,"KRN",.84,0) .84 "BLD",2982,"KRN",3.6,0) 3.6 "BLD",2982,"KRN",3.8,0) 3.8 "BLD",2982,"KRN",9.2,0) 9.2 "BLD",2982,"KRN",9.8,0) 9.8 "BLD",2982,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",2982,"KRN",9.8,"NM",1,0) DGRUDYN^^0^B10202392 "BLD",2982,"KRN",9.8,"NM","B","DGRUDYN",1) "BLD",2982,"KRN",19,0) 19 "BLD",2982,"KRN",19.1,0) 19.1 "BLD",2982,"KRN",101,0) 101 "BLD",2982,"KRN",101,"NM",0) ^9.68A^10^10 "BLD",2982,"KRN",101,"NM",1,0) DGRU-RAI-A01^^0 "BLD",2982,"KRN",101,"NM",2,0) DGRU-RAI-A02^^0 "BLD",2982,"KRN",101,"NM",3,0) DGRU-RAI-A03^^0 "BLD",2982,"KRN",101,"NM",4,0) DGRU-RAI-A08^^0 "BLD",2982,"KRN",101,"NM",5,0) DGRU-RAI-A11^^0 "BLD",2982,"KRN",101,"NM",6,0) DGRU-RAI-A12^^0 "BLD",2982,"KRN",101,"NM",7,0) DGRU-RAI-A13^^0 "BLD",2982,"KRN",101,"NM",8,0) DGRU-RAI-A22^^0 "BLD",2982,"KRN",101,"NM",9,0) DGRU-RAI-A21^^0 "BLD",2982,"KRN",101,"NM",10,0) DGRU-RAI-MFU^^0 "BLD",2982,"KRN",101,"NM","B","DGRU-RAI-A01",1) "BLD",2982,"KRN",101,"NM","B","DGRU-RAI-A02",2) "BLD",2982,"KRN",101,"NM","B","DGRU-RAI-A03",3) "BLD",2982,"KRN",101,"NM","B","DGRU-RAI-A08",4) "BLD",2982,"KRN",101,"NM","B","DGRU-RAI-A11",5) "BLD",2982,"KRN",101,"NM","B","DGRU-RAI-A12",6) "BLD",2982,"KRN",101,"NM","B","DGRU-RAI-A13",7) "BLD",2982,"KRN",101,"NM","B","DGRU-RAI-A21",9) "BLD",2982,"KRN",101,"NM","B","DGRU-RAI-A22",8) "BLD",2982,"KRN",101,"NM","B","DGRU-RAI-MFU",10) "BLD",2982,"KRN",409.61,0) 409.61 "BLD",2982,"KRN",771,0) 771 "BLD",2982,"KRN",870,0) 870 "BLD",2982,"KRN",8989.51,0) 8989.51 "BLD",2982,"KRN",8989.52,0) 8989.52 "BLD",2982,"KRN",8994,0) 8994 "BLD",2982,"KRN","B",.4,.4) "BLD",2982,"KRN","B",.401,.401) "BLD",2982,"KRN","B",.402,.402) "BLD",2982,"KRN","B",.403,.403) "BLD",2982,"KRN","B",.5,.5) "BLD",2982,"KRN","B",.84,.84) "BLD",2982,"KRN","B",3.6,3.6) "BLD",2982,"KRN","B",3.8,3.8) "BLD",2982,"KRN","B",9.2,9.2) "BLD",2982,"KRN","B",9.8,9.8) "BLD",2982,"KRN","B",19,19) "BLD",2982,"KRN","B",19.1,19.1) "BLD",2982,"KRN","B",101,101) "BLD",2982,"KRN","B",409.61,409.61) "BLD",2982,"KRN","B",771,771) "BLD",2982,"KRN","B",870,870) "BLD",2982,"KRN","B",8989.51,8989.51) "BLD",2982,"KRN","B",8989.52,8989.52) "BLD",2982,"KRN","B",8994,8994) "BLD",2982,"QUES",0) ^9.62^^ "BLD",2982,"REQB",0) ^9.611^2^2 "BLD",2982,"REQB",1,0) HL*1.6*93^2 "BLD",2982,"REQB",2,0) DG*5.3*473^2 "BLD",2982,"REQB","B","DG*5.3*473",2) "BLD",2982,"REQB","B","HL*1.6*93",1) "KRN",101,4388,-1) 0^4 "KRN",101,4388,0) DGRU-RAI-A08^^^S^^^^^^^^ "KRN",101,4388,770) ^DGRU RAI CLIENT^^A08^^^^^^^ACK "KRN",101,4388,773) 1^1 "KRN",101,4392,-1) 0^6 "KRN",101,4392,0) DGRU-RAI-A12^A12 CLIENT PROTOCOL^^S^^^^^^^^REGISTRATION "KRN",101,4392,99) 59255,61337 "KRN",101,4392,770) ^DGRU RAI CLIENT^^A12^^^^^^^ADT "KRN",101,4392,773) 1^1 "KRN",101,4393,-1) 0^9 "KRN",101,4393,0) DGRU-RAI-A21^A21 CLIENT PROTOCOL^^S^^^^^^^^REGISTRATION "KRN",101,4393,99) 59255,61337 "KRN",101,4393,770) ^DGRU RAI CLIENT^^A21^^^^^^^ADT "KRN",101,4393,773) 1^1 "KRN",101,4394,-1) 0^8 "KRN",101,4394,0) DGRU-RAI-A22^A22 CLIENT PROTOCOL^^S^^^^^^^^REGISTRATION "KRN",101,4394,99) 59255,61337 "KRN",101,4394,770) ^DGRU RAI CLIENT^^A22^^^^^^^ADT "KRN",101,4394,773) 1^1 "KRN",101,4395,-1) 0^7 "KRN",101,4395,0) DGRU-RAI-A13^A13 CLIENT PROTOCOL^^S^^^^^^^^REGISTRATION "KRN",101,4395,99) 59255,61885 "KRN",101,4395,770) ^DGRU RAI CLIENT^^A13^^^^^^^ADT "KRN",101,4395,773) 1^1 "KRN",101,4396,-1) 0^1 "KRN",101,4396,0) DGRU-RAI-A01^A01 CLIENT PROTOCOL^^S^^^^^^^^REGISTRATION "KRN",101,4396,99) 59255,62555 "KRN",101,4396,770) ^DGRU RAI CLIENT^^A01^^^^^^^ADT "KRN",101,4396,773) 1^1 "KRN",101,4397,-1) 0^3 "KRN",101,4397,0) DGRU-RAI-A03^A03 CLIENT PROTOCOL^^S^^^^^^^^REGISTRATION "KRN",101,4397,99) 59255,62827 "KRN",101,4397,770) ^DGRU RAI CLIENT^^A03^^^^^^^ADT "KRN",101,4397,773) 1^1 "KRN",101,4398,-1) 0^10 "KRN",101,4398,0) DGRU-RAI-MFU^MFU CLIENT PROTOCOL^^S^^^^^^^^REGISTRATION "KRN",101,4398,99) 59255,62827 "KRN",101,4398,770) ^DGRU RAI CLIENT^^M01^^^^^^^MFN "KRN",101,4398,773) 1^1 "KRN",101,4399,-1) 0^2 "KRN",101,4399,0) DGRU-RAI-A02^A02 CLIENT PROTOCOL^^S^^^^^^^^REGISTRATION "KRN",101,4399,99) 59255,63175 "KRN",101,4399,770) ^DGRU RAI CLIENT^^A02^^^^^^^ADT "KRN",101,4399,773) 1^1 "KRN",101,4400,-1) 0^5 "KRN",101,4400,0) DGRU-RAI-A11^A11 CLIENT PROTOCOL^^S^^^^^^^^REGISTRATION "KRN",101,4400,99) 59255,63175 "KRN",101,4400,770) ^DGRU RAI CLIENT^^A11^^^^^^^ADT "KRN",101,4400,773) 1^1 "MBREQ") 0 "ORD",15,101) 101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA "ORD",15,101,0) PROTOCOL "PKG",114,-1) 1^1 "PKG",114,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",114,20,0) ^9.402P^^ "PKG",114,22,0) ^9.49I^1^1 "PKG",114,22,1,0) 5.3^2930813^2930821 "PKG",114,22,1,"PAH",1,0) 501^3030623 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") YES "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") YES "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 1 "RTN","DGRUDYN") 0^1^B10202392 "RTN","DGRUDYN",1,0) DGRUDYN ;ALB/SCK - RAI/MDS COTS DYNAMIC ADDRESSING ROUTINE; 9-2-99 ; 6/23/03 3:25pm "RTN","DGRUDYN",2,0) ;;5.3;Registration;**190,328,354,357,473,501**;Aug 13, 1993 "RTN","DGRUDYN",3,0) ; "RTN","DGRUDYN",4,0) EN(EVENT) ; "RTN","DGRUDYN",5,0) ; "RTN","DGRUDYN",6,0) ; Input CLIENT - HL7 Client protocol "RTN","DGRUDYN",7,0) ; DGWARD - Ward location [Optional] "RTN","DGRUDYN",8,0) ; "RTN","DGRUDYN",9,0) N DGENTRY,DGDIV,DGSCN,DGSITE,HLNODE,DGSTN,DGWARD,DGIEN,DGFAC,CLIENT "RTN","DGRUDYN",10,0) ; "RTN","DGRUDYN",11,0) Q:$G(EVENT)']"" "RTN","DGRUDYN",12,0) ; "RTN","DGRUDYN",13,0) ; Extract HL7 message to local array for processing "RTN","DGRUDYN",14,0) N I,J,X "RTN","DGRUDYN",15,0) F I=1:1 X HLNEXT Q:HLQUIT'>0 D "RTN","DGRUDYN",16,0) . S X(I)=HLNODE,J=0 "RTN","DGRUDYN",17,0) . F S J=$O(HLNODE(J)) Q:'J S X(I,J)=HLNODE(J) "RTN","DGRUDYN",18,0) ; "RTN","DGRUDYN",19,0) ; Look for PV1 segment. If A03 or A21, get previous ward, otherwise get current ward location. "RTN","DGRUDYN",20,0) S I=0 "RTN","DGRUDYN",21,0) F S I=$O(X(I)) Q:'I D "RTN","DGRUDYN",22,0) . I $P(X(I),"^",1)="PV1" D "RTN","DGRUDYN",23,0) . . I "A03"[EVENT S DGWARD=$$WARD(X(I),7) "RTN","DGRUDYN",24,0) . . I "A11"[EVENT S DGWARD=$$WARD(X(I),7) ; Retrieve ward prior toadmission cancellation "RTN","DGRUDYN",25,0) . . I "A21"[EVENT S DGWARD=$$WARD(X(I),7) "RTN","DGRUDYN",26,0) . . I '$G(DGWARD) S DGWARD=$$WARD(X(I),4) "RTN","DGRUDYN",27,0) ; "RTN","DGRUDYN",28,0) ; Get division for ward "RTN","DGRUDYN",29,0) S DGDIV=+$$GET1^DIQ(42,DGWARD,.015,"I") "RTN","DGRUDYN",30,0) ; "RTN","DGRUDYN",31,0) ; Retrieve subscription control number for division "RTN","DGRUDYN",32,0) S DGSCN=+$$GET1^DIQ(40.8,DGDIV,900.01) "RTN","DGRUDYN",33,0) ; "RTN","DGRUDYN",34,0) ;set HLL("LINKS") array "RTN","DGRUDYN",35,0) K HLL ;added p-357 "RTN","DGRUDYN",36,0) D GET^HLSUB(DGSCN,2,"",.HLL) ;added p-357 "RTN","DGRUDYN",37,0) ; "RTN","DGRUDYN",38,0) ; Set client protocol for destination "RTN","DGRUDYN",39,0) S DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV) "RTN","DGRUDYN",40,0) ; S DGAPIEN=$P(HLL("LINKS",1),"^",4) ;changed p-357, disabled p-501 "RTN","DGRUDYN",41,0) S DGAPIEN=$$GET1^DIQ(771,$P(HLL("LINKS",1),"^",4),.01) ; added p-501 "RTN","DGRUDYN",42,0) S DGFAC=$$GET1^DIQ(771,$P(HLL("LINKS",1),"^",4),3) ; added p-501 "RTN","DGRUDYN",43,0) ; S CLIENT="DGRU-RAI-"_EVENT_"-"_DGAPIEN ;changed p-357,disabled p501 "RTN","DGRUDYN",44,0) S CLIENT="DGRU-RAI-"_EVENT ; added p-501 "RTN","DGRUDYN",45,0) S $P(HLL("LINKS",1),"^",1)=CLIENT ;changed p-357 "RTN","DGRUDYN",46,0) S HLP("SUBSCRIBER")="^^^"_DGAPIEN_"^"_DGFAC ; added p-501 "RTN","DGRUDYN",47,0) Q "RTN","DGRUDYN",48,0) ; "RTN","DGRUDYN",49,0) WARD(DGPV1,DGP) ; Retrieve Ward IEN for Division lookup. If the ward has been "RTN","DGRUDYN",50,0) ; "translated", then return the original Ward IEN. "RTN","DGRUDYN",51,0) ; Input "RTN","DGRUDYN",52,0) ; DGPV1 - Copy of the PV1 segment "RTN","DGRUDYN",53,0) ; DGP - Piece containing the ward to be checked "RTN","DGRUDYN",54,0) ; "RTN","DGRUDYN",55,0) N DGW,DGN,Y,DIC,DGIEN,DGX "RTN","DGRUDYN",56,0) ; "RTN","DGRUDYN",57,0) S DGW=$P(DGPV1,"^",DGP),DGN=$P(DGW,"~",1) "RTN","DGRUDYN",58,0) S DGIEN=$$FIND1^DIC(42,"","BX",DGN,"","","DGERR") "RTN","DGRUDYN",59,0) ; "RTN","DGRUDYN",60,0) ; If the Lookup is unable to find a valid ward location, then check to see if this "RTN","DGRUDYN",61,0) ; is a translated ward name. If it is, then return original ward ien "RTN","DGRUDYN",62,0) I DGIEN<1 D "RTN","DGRUDYN",63,0) . S DGX=$$FIND1^DIC(46.12,"","",DGN,"AC") "RTN","DGRUDYN",64,0) . I DGX>0 S DGIEN=+$G(^DGRU(46.12,DGX,0)) ;p-473 "RTN","DGRUDYN",65,0) . E D ;p-473 "RTN","DGRUDYN",66,0) .. S DGX=$O(^DGRU(46.12,"AC",DGN,0)) ;p-473 "RTN","DGRUDYN",67,0) .. I DGX>0 S DGIEN=+$G(^DGRU(46.12,DGX,0)) ;p-473 "RTN","DGRUDYN",68,0) Q DGIEN "RTN","DGRUDYN",69,0) ; "RTN","DGRUDYN",70,0) ENMFU(DGEVENT,DGDIV) ;ENTRY POINT FOR MASTER FILE UPDATE ROUTING "RTN","DGRUDYN",71,0) ; "RTN","DGRUDYN",72,0) N DGAPIEN,DGFAC,CLIENT "RTN","DGRUDYN",73,0) S DGSCN=$$GET1^DIQ(40.8,DGDIV,900.01) ;Retrieve the Subscription Control Number for the division "RTN","DGRUDYN",74,0) Q:DGSCN']"" ;Quit if division does not have a Subscription Control Number "RTN","DGRUDYN",75,0) S DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV) ;Retrieve station info for division "RTN","DGRUDYN",76,0) K HLL ;changed p-357 "RTN","DGRUDYN",77,0) D GET^HLSUB(DGSCN,2,"",.HLL) ;changed p-357 "RTN","DGRUDYN",78,0) ; S DGAPIEN=$P(HLL("LINKS",1),"^",4) ;ADDED P-357, disabled p-501 "RTN","DGRUDYN",79,0) S DGAPIEN=$$GET1^DIQ(771,$P(HLL("LINKS",1),"^",4),.01) ; added p-501 "RTN","DGRUDYN",80,0) S DGFAC=$$GET1^DIQ(771,$P(HLL("LINKS",1),"^",4),3) ; added p-501 "RTN","DGRUDYN",81,0) ; S CLIENT="DGRU-RAI-"_DGEVENT_"-"_DGAPIEN ;changed p-357 Set client variable using event type and receiving app,disabled p-501 "RTN","DGRUDYN",82,0) S CLIENT="DGRU-RAI-"_DGEVENT ; added p-501 "RTN","DGRUDYN",83,0) S $P(HLL("LINKS",1),"^",1)=CLIENT ;added p-357 "RTN","DGRUDYN",84,0) S HLP("SUBSCRIBER")="^^^"_DGAPIEN_"^"_DGFAC ; added p-501 "RTN","DGRUDYN",85,0) Q "RTN","DGRUDYN",86,0) ; "VER") 8.0^22.0 **END** **END**