| [613] | 1 | DGRUGZDC ;ALB/GRR - HL7 ZDC SEGMENT BUILDER ;06/08/99
|
|---|
| 2 | ;;5.3;Registration;**190**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;This routine will build an HL7 ZDC segment for an inpatient.
|
|---|
| 5 | ;
|
|---|
| 6 | EN(DFN,DGDC,DGSSNC,DGMDT) ;Entry point of routine
|
|---|
| 7 | ;DFN - Patient Internal Entry Number
|
|---|
| 8 | ;DGDC -Type of date Change~Prior Date
|
|---|
| 9 | ;DGSSNC - Prior SSN
|
|---|
| 10 | ;DGMDT - Movement Date
|
|---|
| 11 | ;DGDC - Type of date change^Prior date
|
|---|
| 12 | ;
|
|---|
| 13 | S DGMDT=$$HLDATE^HLFNC(DGMDT)
|
|---|
| 14 | N DGRREC ;Initialize variables
|
|---|
| 15 | S $P(DGRREC,HL("FS"))="ZDC" ;Set segment ID to ZDC
|
|---|
| 16 | S $P(DGRREC,HL("FS"),2)=1 ;Set Set ID to 1
|
|---|
| 17 | I $G(DGDC)]"" S DGCDT=$P(DGDC,"^",2),DGODT=$$HLDATE^HLFNC(DGCDT) D ;If date change do the following
|
|---|
| 18 | .I $E(DGDC)="A" D ;If Admit date changed
|
|---|
| 19 | ..S $P(DGRREC,HL("FS"),3)=1 ;Set type to 1
|
|---|
| 20 | ..S $P(DGRREC,HL("FS"),4)=DGODT ;old date
|
|---|
| 21 | ..S $P(DGRREC,HL("FS"),5)=DGMDT ;new date
|
|---|
| 22 | .I $E(DGDC)="T" D ;If Transfer date changed
|
|---|
| 23 | ..S $P(DGRREC,HL("FS"),3)=2 ;Set type to 2
|
|---|
| 24 | ..S $P(DGRREC,HL("FS"),4)=DGODT ;old date
|
|---|
| 25 | ..S $P(DGRREC,HL("FS"),5)=DGMDT ;new date
|
|---|
| 26 | .I $E(DGDC)="D" D ;If Discharge date changed
|
|---|
| 27 | ..S $P(DGRREC,HL("FS"),3)=3 ;Set type to 3
|
|---|
| 28 | ..S $P(DGRREC,HL("FS"),4)=DGODT ;old date
|
|---|
| 29 | ..S $P(DGRREC,HL("FS"),5)=DGMDT ;new date
|
|---|
| 30 | I $G(DGSSNC)]"" D ;If SSN change, do the following
|
|---|
| 31 | .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
|
|---|
| 32 | .S $P(DGRREC,HL("FS"),6)=DGSSNC ;old SSN
|
|---|
| 33 | .S SSN=$$GET1^DIQ(2,DFN,.09,"I") ;Get new SSN
|
|---|
| 34 | .S $P(DGRREC,HL("FS"),7)=SSN ;Set new SSN in message
|
|---|
| 35 | EXIT ;
|
|---|
| 36 | Q DGRREC ;Quit and return formatted segment
|
|---|
