DGRUGZDC.m

DGRUGZDC ;ALB/GRR - HL7 ZDC SEGMENT BUILDER ;06/08/99

 ;;5.3;Registration;**190,1015**;Aug 13, 1993;Build 21

 ;

 ;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

DGRUGZDC  ;ALB/GRR - HL7 ZDC SEGMENT BUILDER ;06/08/99

 +1       ;;5.3;Registration;**190,1015**;Aug 13, 1993;Build 21

 +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