DGRUGZDC ;ALB/GRR - HL7 ZDC SEGMENT BUILDER ;06/08/99
;;5.3;Registration;**190**;Aug 13, 1993
;
;This routine will build an HL7 ZDC segment for an inpatient.
;
EN(DFN,DGDC,DGSSNC,DGMDT) ;Entry point of routine
;DFN - Patient Internal Entry Number
;DGDC -Type of date Change~Prior Date
;DGSSNC - Prior SSN
;DGMDT - Movement Date
;DGDC - Type of date change^Prior date
;
S DGMDT=$$HLDATE^HLFNC(DGMDT)
N DGRREC ;Initialize variables
S $P(DGRREC,HL("FS"))="ZDC" ;Set segment ID to ZDC
S $P(DGRREC,HL("FS"),2)=1 ;Set Set ID to 1
I $G(DGDC)]"" S DGCDT=$P(DGDC,"^",2),DGODT=$$HLDATE^HLFNC(DGCDT) D ;If date change do the following
.I $E(DGDC)="A" D ;If Admit date changed
..S $P(DGRREC,HL("FS"),3)=1 ;Set type to 1
..S $P(DGRREC,HL("FS"),4)=DGODT ;old date
..S $P(DGRREC,HL("FS"),5)=DGMDT ;new date
.I $E(DGDC)="T" D ;If Transfer date changed
..S $P(DGRREC,HL("FS"),3)=2 ;Set type to 2
..S $P(DGRREC,HL("FS"),4)=DGODT ;old date
..S $P(DGRREC,HL("FS"),5)=DGMDT ;new date
.I $E(DGDC)="D" D ;If Discharge date changed
..S $P(DGRREC,HL("FS"),3)=3 ;Set type to 3
..S $P(DGRREC,HL("FS"),4)=DGODT ;old date
..S $P(DGRREC,HL("FS"),5)=DGMDT ;new date
I $G(DGSSNC)]"" D ;If SSN change, do the following
.S $P(DGRREC,HL("FS"),3)=+$P(DGRREC,HL("FS"),3)+10 ;Set type to current value plus 10. If date change and SSN, type is 11, 12, or 13. Will be a 10 for SSN change only
.S $P(DGRREC,HL("FS"),6)=DGSSNC ;old SSN
.S SSN=$$GET1^DIQ(2,DFN,.09,"I") ;Get new SSN
.S $P(DGRREC,HL("FS"),7)=SSN ;Set new SSN in message
EXIT ;
Q DGRREC ;Quit and return formatted segment
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUGZDC 1621 printed Dec 13, 2024@02:58:38 Page 2
DGRUGZDC ;ALB/GRR - HL7 ZDC SEGMENT BUILDER ;06/08/99
+1 ;;5.3;Registration;**190**;Aug 13, 1993
+2 ;
+3 ;This routine will build an HL7 ZDC segment for an inpatient.
+4 ;
EN(DFN,DGDC,DGSSNC,DGMDT) ;Entry point of routine
+1 ;DFN - Patient Internal Entry Number
+2 ;DGDC -Type of date Change~Prior Date
+3 ;DGSSNC - Prior SSN
+4 ;DGMDT - Movement Date
+5 ;DGDC - Type of date change^Prior date
+6 ;
+7 SET DGMDT=$$HLDATE^HLFNC(DGMDT)
+8 ;Initialize variables
NEW DGRREC
+9 ;Set segment ID to ZDC
SET $PIECE(DGRREC,HL("FS"))="ZDC"
+10 ;Set Set ID to 1
SET $PIECE(DGRREC,HL("FS"),2)=1
+11 ;If date change do the following
IF $GET(DGDC)]""
SET DGCDT=$PIECE(DGDC,"^",2)
SET DGODT=$$HLDATE^HLFNC(DGCDT)
Begin DoDot:1
+12 ;If Admit date changed
IF $EXTRACT(DGDC)="A"
Begin DoDot:2
+13 ;Set type to 1
SET $PIECE(DGRREC,HL("FS"),3)=1
+14 ;old date
SET $PIECE(DGRREC,HL("FS"),4)=DGODT
+15 ;new date
SET $PIECE(DGRREC,HL("FS"),5)=DGMDT
End DoDot:2
+16 ;If Transfer date changed
IF $EXTRACT(DGDC)="T"
Begin DoDot:2
+17 ;Set type to 2
SET $PIECE(DGRREC,HL("FS"),3)=2
+18 ;old date
SET $PIECE(DGRREC,HL("FS"),4)=DGODT
+19 ;new date
SET $PIECE(DGRREC,HL("FS"),5)=DGMDT
End DoDot:2
+20 ;If Discharge date changed
IF $EXTRACT(DGDC)="D"
Begin DoDot:2
+21 ;Set type to 3
SET $PIECE(DGRREC,HL("FS"),3)=3
+22 ;old date
SET $PIECE(DGRREC,HL("FS"),4)=DGODT
+23 ;new date
SET $PIECE(DGRREC,HL("FS"),5)=DGMDT
End DoDot:2
End DoDot:1
+24 ;If SSN change, do the following
IF $GET(DGSSNC)]""
Begin DoDot:1
+25 ;Set type to current value plus 10. If date change and SSN, type is 11, 12, or 13. Will be a 10 for SSN change only
SET $PIECE(DGRREC,HL("FS"),3)=+$PIECE(DGRREC,HL("FS"),3)+10
+26 ;old SSN
SET $PIECE(DGRREC,HL("FS"),6)=DGSSNC
+27 ;Get new SSN
SET SSN=$$GET1^DIQ(2,DFN,.09,"I")
+28 ;Set new SSN in message
SET $PIECE(DGRREC,HL("FS"),7)=SSN
End DoDot:1
EXIT ;
+1 ;Quit and return formatted segment
QUIT DGRREC
