PSDADT.m

PSDADT ;BIR/LTL- ADT Message builder for HL7 ; 13 Feb 95

 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

 Q:("123"'[$P(DGPMA,U,2))

 N HLERR,HLEVN,HLNDAP,HLMTN,HLFS,HLECH,HLSDATA,HLSDT,HLSEC,HLCHAR,HLDA,HLDAN,HLDAP,HLDT,HLDT1,HLNDAP0,HLPID,HLQ,HLVER

 S HLNDAP="PSD-NDES" D INIT^HLTRANS I $D(HLERR) D KILL^HLTRANS Q

 D EVN($P(DGPMA,U,2),$P(DGPMA,U))

 S HLMTN="ADT",HLEVN=1

PID S HLSDATA(2)=$$EN^VAFHLPID(DFN,"1,2,3,5")

PV1 N VAROOT,VAINDT S VAROOT="PSD",VAINDT=$P(DGPMA,U) D INP^VADPT

 S $P(HLSDATA(3),HLFS,8)=""

 S $P(HLSDATA(3),HLFS)="PV1"

 S $P(HLSDATA(3),HLFS,4)=$P(PSD(4),U,2)_$E(HLECH)_$P(PSD(5),"-")_$E(HLECH)_$P(PSD(5),"-",2)

 S $P(HLSDATA(3),HLFS,7)=$E(HLECH)_$E(HLECH)

 S $P(HLSDATA(3),HLFS,8)=$P(PSD(2),U)_$E(HLECH)_$$HLNAME^HLFNC($P(PSD(2),U,2))

 D:$P(DGPMA,U,2)=2

 .N VAROOT,VAINDT S VAROOT="PSD",VAINDT=$P(DGPMA,U) D IN5^VADPT

 .S $P(HLSDATA(3),HLFS,7)=$P(PSD(15,4),U,2)_$E(HLECH)_$E(HLECH)

SEND D EN^HLTRANS K PSD Q

EVN(EVENT,DATE) ;EVN Segment builder

 S HLSDATA(1)="EVN"_HLFS_"A0"_EVENT_HLFS_$$HLDATE^HLFNC(DATE) Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSDADT   1044     printed  Apr 09, 2024@20:53:41                                                                                                                                                                                                      Page 2

PSDADT    ;BIR/LTL- ADT Message builder for HL7 ; 13 Feb 95

 +1       ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

 +2        if ("123"'[$PIECE(DGPMA,U,2))

               QUIT 

 +3        NEW HLERR,HLEVN,HLNDAP,HLMTN,HLFS,HLECH,HLSDATA,HLSDT,HLSEC,HLCHAR,HLDA,HLDAN,HLDAP,HLDT,HLDT1,HLNDAP0,HLPID,HLQ,HLVER

 +4        SET HLNDAP="PSD-NDES"

           DO INIT^HLTRANS

           IF $DATA(HLERR)

               DO KILL^HLTRANS

               QUIT 

 +5        DO EVN($PIECE(DGPMA,U,2),$PIECE(DGPMA,U))

 +6        SET HLMTN="ADT"

           SET HLEVN=1

PID        SET HLSDATA(2)=$$EN^VAFHLPID(DFN,"1,2,3,5")

PV1        NEW VAROOT,VAINDT

           SET VAROOT="PSD"

           SET VAINDT=$PIECE(DGPMA,U)

           DO INP^VADPT

 +1        SET $PIECE(HLSDATA(3),HLFS,8)=""

 +2        SET $PIECE(HLSDATA(3),HLFS)="PV1"

 +3        SET $PIECE(HLSDATA(3),HLFS,4)=$PIECE(PSD(4),U,2)_$EXTRACT(HLECH)_$PIECE(PSD(5),"-")_$EXTRACT(HLECH)_$PIECE(PSD(5),"-",2)

 +4        SET $PIECE(HLSDATA(3),HLFS,7)=$EXTRACT(HLECH)_$EXTRACT(HLECH)

 +5        SET $PIECE(HLSDATA(3),HLFS,8)=$PIECE(PSD(2),U)_$EXTRACT(HLECH)_$$HLNAME^HLFNC($PIECE(PSD(2),U,2))

 +6        if $PIECE(DGPMA,U,2)=2

               Begin DoDot:1

 +7                NEW VAROOT,VAINDT

                   SET VAROOT="PSD"

                   SET VAINDT=$PIECE(DGPMA,U)

                   DO IN5^VADPT

 +8                SET $PIECE(HLSDATA(3),HLFS,7)=$PIECE(PSD(15,4),U,2)_$EXTRACT(HLECH)_$EXTRACT(HLECH)

               End DoDot:1

SEND       DO EN^HLTRANS

           KILL PSD

           QUIT 

EVN(EVENT,DATE) ;EVN Segment builder

 +1        SET HLSDATA(1)="EVN"_HLFS_"A0"_EVENT_HLFS_$$HLDATE^HLFNC(DATE)

           QUIT