- 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 Feb 19, 2025@00:24:40 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
