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 ---[H[J[2J[HPSDADT 1044 printed Nov 22, 2024@16:55:10 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
