DGRUGMFU ;ALB/GRR - CREATE MFU MESSAGE
;;5.3;Registration;**190,349,381**;AUG 13, 1993
EN(DGRSEGC,DGRSEGN,DGRFNUM,DGRFNAM,DGROLDN,DGRENM,DGCIEN) ;
K ^TMP($J,"DGRUGMFU")
;;Input parameters:
;; DGRSEGC - Segment Code (Z36,LOC,STF)
;; DGRSEGN - Segment Name (LOCATION, STAFF)
;; DGRFNUM - File Number of master file
;; DGRFNAM - Master File Name (NEW PERSON)
;; DGROLDN - Value of name prior to change
;; DGRENM - Name field of changed entry
;; DGRCIEN - Internal Entry Number of changed entry
N DGREC,DGREDT,DGRROOM,DGRBED,DGRWARD,DGRWIEN
D INIT^HLFNC2("DGRU-RAI-MFU-SERVER",.HL) ;p-381 added
D NOW^%DTC S DGREDT=$$HLDATE^HLFNC(%) ;Current Date/Time
S DGREC="MFI"_HL("FS")_DGRSEGC_$E(HL("ECH"))_DGRSEGN_$E(HL("ECH"))_"HL7"_$E(HL("ECH"))_DGRFNUM_$E(HL("ECH"))_DGRFNAM_HL("FS")_HL("FS")_"UPD"_HL("FS")_DGREDT_HL("FS")_HL("FS")_"NE" ;Format MFI HL7 segment
S ^TMP($J,"DGRUGMFU",1)=DGREC ;Store MFI segment into global array
S DGREC="MFE"_HL("FS")_"MUP"_HL("FS")_HL("FS")_DGREDT_HL("FS")_DGCIEN_$E(HL("ECH"))_DGROLDN_$E(HL("ECH"))_"HL7" ;Format the MFE HL7 segment
S ^TMP($J,"DGRUGMFU",2)=DGREC ;Store MFE segment into array
I DGRSEGC="Z36" D G EXIT ;If Z36 segment (Insurance), do following and exit
.S DGREC="Z36"_HL("FS")_DGCIEN_$E(HL("ECH"))_DGRENM ;Format Z36 segment
.S ^TMP($J,"DGRUGMFU",3)=DGREC ;Store Z36 segment into array
I DGRSEGC="STF" D G EXIT ;If STF segment, do following and exit
.S DGREC="STF"_HL("FS")_DGCIEN_$E(HL("ECH"))_DGROLDN_$E(HL("ECH"))_DGRFNUM_HL("FS")_HL("FS")_$$HLNAME^HLFNC(DGRENM) ;Format the STF segment
.S $P(DGREC,HL("FS"),19)=$$GET1^DIQ(200,DGCIEN,8,"E") ;Set the Job title into sequence 18 (piece 19)
.S ^TMP($J,"DGRUGMFU",3)=DGREC ;Store STF segment into array
I DGRSEGC="LOC" D G EXIT ;If LOC segment, do the following and exit
.I DGRFNUM=405.4 D ;If the LOC is for Room-Bed change, do the following
..S DGRROOM=$P(DGRENM,"-") ;Set room variable
..S DGRBED=$P(DGRENM,"-",2) ;Set bed variable
..S DGRWIEN=$O(^DG(405.4,DGCIEN,"W",0)) ;Set variable to Ward IEN
..S I=$P($G(^DG(405.4,DGCIEN,"W",DGRWIEN,0)),"^") ;Set variable to IEN in Room-Bed file
..S DGRWARD=$$GET1^DIQ(42,I,.01) ;Set variable to Ward location file name
..I DGRWARD]"" S DGRWARD=$$WARDTRAN^DGRUUTL1(I,DGRWARD) ;p-381 added
..S $P(^TMP($J,"DGRUGMFU",2),"^",5)=DGRWARD_$E(HL("ECH"))_DGROLDN_$E(HL("ECH"))_"HL7" ;
.I DGRFNUM=42 D
..S DGRROOM="",DGRBED="",DGRWARD=$$GET1^DIQ(42,DGCIEN,.01)
.I DGRROOM]"" S DGRBH=$$RBTRAN^DGRUUTL1(DGCIEN,DGRROOM_"-"_DGRBED) S DGRROOM=$P(DGRBH,"-",1),DGRBED=$P(DGRBH,"-",2) ;modified p-328
.I DGRWARD]"" S DGRWARD=$$WARDTRAN^DGRUUTL1(DGCIEN,DGRWARD) ;changed p-349
.S DGREC="LOC"_HL("FS")_DGRWARD_$E(HL("ECH"))_DGRROOM_$E(HL("ECH"))_DGRBED_$E(HL("ECH"))_$E(HL("ECH"))_$E(HL("ECH"))_"NURSING UNIT"_HL("FS")_HL("FS")_"N"
.S ^TMP($J,"DGRUGMFU",3)=DGREC
EXIT Q
;
ENGET() ;DETERMINE DIVISION TO GET SUBSCRIBERS
;
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 LOC segment
S I=0
F S I=$O(X(I)) Q:'I D
.I $P(X(I),"^",1)="LOC" D
..S DGWARD=$$WARD^DGRUDYN(X(I),2)
S DGDIV=+$$GET1^DIQ(42,DGWARD,.015,"I")
Q DGDIV
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUGMFU 3226 printed Nov 22, 2024@18:08:26 Page 2
DGRUGMFU ;ALB/GRR - CREATE MFU MESSAGE
+1 ;;5.3;Registration;**190,349,381**;AUG 13, 1993
EN(DGRSEGC,DGRSEGN,DGRFNUM,DGRFNAM,DGROLDN,DGRENM,DGCIEN) ;
+1 KILL ^TMP($JOB,"DGRUGMFU")
+2 ;;Input parameters:
+3 ;; DGRSEGC - Segment Code (Z36,LOC,STF)
+4 ;; DGRSEGN - Segment Name (LOCATION, STAFF)
+5 ;; DGRFNUM - File Number of master file
+6 ;; DGRFNAM - Master File Name (NEW PERSON)
+7 ;; DGROLDN - Value of name prior to change
+8 ;; DGRENM - Name field of changed entry
+9 ;; DGRCIEN - Internal Entry Number of changed entry
+10 NEW DGREC,DGREDT,DGRROOM,DGRBED,DGRWARD,DGRWIEN
+11 ;p-381 added
DO INIT^HLFNC2("DGRU-RAI-MFU-SERVER",.HL)
+12 ;Current Date/Time
DO NOW^%DTC
SET DGREDT=$$HLDATE^HLFNC(%)
+13 ;Format MFI HL7 segment
SET DGREC="MFI"_HL("FS")_DGRSEGC_$EXTRACT(HL("ECH"))_DGRSEGN_$EXTRACT(HL("ECH"))_"HL7"_$EXTRACT(HL("ECH"))_DGRFNUM_$EXTRACT(HL("ECH"))_DGRFNAM_HL("FS")_HL("FS")_"UPD"_HL("FS")_DGREDT_HL("FS")_HL("FS")_"NE"
+14 ;Store MFI segment into global array
SET ^TMP($JOB,"DGRUGMFU",1)=DGREC
+15 ;Format the MFE HL7 segment
SET DGREC="MFE"_HL("FS")_"MUP"_HL("FS")_HL("FS")_DGREDT_HL("FS")_DGCIEN_$EXTRACT(HL("ECH"))_DGROLDN_$EXTRACT(HL("ECH"))_"HL7"
+16 ;Store MFE segment into array
SET ^TMP($JOB,"DGRUGMFU",2)=DGREC
+17 ;If Z36 segment (Insurance), do following and exit
IF DGRSEGC="Z36"
Begin DoDot:1
+18 ;Format Z36 segment
SET DGREC="Z36"_HL("FS")_DGCIEN_$EXTRACT(HL("ECH"))_DGRENM
+19 ;Store Z36 segment into array
SET ^TMP($JOB,"DGRUGMFU",3)=DGREC
End DoDot:1
GOTO EXIT
+20 ;If STF segment, do following and exit
IF DGRSEGC="STF"
Begin DoDot:1
+21 ;Format the STF segment
SET DGREC="STF"_HL("FS")_DGCIEN_$EXTRACT(HL("ECH"))_DGROLDN_$EXTRACT(HL("ECH"))_DGRFNUM_HL("FS")_HL("FS")_$$HLNAME^HLFNC(DGRENM)
+22 ;Set the Job title into sequence 18 (piece 19)
SET $PIECE(DGREC,HL("FS"),19)=$$GET1^DIQ(200,DGCIEN,8,"E")
+23 ;Store STF segment into array
SET ^TMP($JOB,"DGRUGMFU",3)=DGREC
End DoDot:1
GOTO EXIT
+24 ;If LOC segment, do the following and exit
IF DGRSEGC="LOC"
Begin DoDot:1
+25 ;If the LOC is for Room-Bed change, do the following
IF DGRFNUM=405.4
Begin DoDot:2
+26 ;Set room variable
SET DGRROOM=$PIECE(DGRENM,"-")
+27 ;Set bed variable
SET DGRBED=$PIECE(DGRENM,"-",2)
+28 ;Set variable to Ward IEN
SET DGRWIEN=$ORDER(^DG(405.4,DGCIEN,"W",0))
+29 ;Set variable to IEN in Room-Bed file
SET I=$PIECE($GET(^DG(405.4,DGCIEN,"W",DGRWIEN,0)),"^")
+30 ;Set variable to Ward location file name
SET DGRWARD=$$GET1^DIQ(42,I,.01)
+31 ;p-381 added
IF DGRWARD]""
SET DGRWARD=$$WARDTRAN^DGRUUTL1(I,DGRWARD)
+32 ;
SET $PIECE(^TMP($JOB,"DGRUGMFU",2),"^",5)=DGRWARD_$EXTRACT(HL("ECH"))_DGROLDN_$EXTRACT(HL("ECH"))_"HL7"
End DoDot:2
+33 IF DGRFNUM=42
Begin DoDot:2
+34 SET DGRROOM=""
SET DGRBED=""
SET DGRWARD=$$GET1^DIQ(42,DGCIEN,.01)
End DoDot:2
+35 ;modified p-328
IF DGRROOM]""
SET DGRBH=$$RBTRAN^DGRUUTL1(DGCIEN,DGRROOM_"-"_DGRBED)
SET DGRROOM=$PIECE(DGRBH,"-",1)
SET DGRBED=$PIECE(DGRBH,"-",2)
+36 ;changed p-349
IF DGRWARD]""
SET DGRWARD=$$WARDTRAN^DGRUUTL1(DGCIEN,DGRWARD)
+37 SET DGREC="LOC"_HL("FS")_DGRWARD_$EXTRACT(HL("ECH"))_DGRROOM_$EXTRACT(HL("ECH"))_DGRBED_$EXTRACT(HL("ECH"))_$EXTRACT(HL("ECH"))_$EXTRACT(HL("ECH"))_"NURSING UNIT"_HL("FS")_HL("FS")_"N"
+38 SET ^TMP($JOB,"DGRUGMFU",3)=DGREC
End DoDot:1
GOTO EXIT
EXIT QUIT
+1 ;
ENGET() ;DETERMINE DIVISION TO GET SUBSCRIBERS
+1 ;
+2 NEW I,J,X
+3 FOR I=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+4 SET X(I)=HLNODE
SET J=0
+5 FOR
SET J=$ORDER(HLNODE(J))
if 'J
QUIT
SET X(I,J)=HLNODE(J)
End DoDot:1
+6 ;LOOK FOR LOC segment
+7 SET I=0
+8 FOR
SET I=$ORDER(X(I))
if 'I
QUIT
Begin DoDot:1
+9 IF $PIECE(X(I),"^",1)="LOC"
Begin DoDot:2
+10 SET DGWARD=$$WARD^DGRUDYN(X(I),2)
End DoDot:2
End DoDot:1
+11 SET DGDIV=+$$GET1^DIQ(42,DGWARD,.015,"I")
+12 QUIT DGDIV
+13 ;
