- PSDADT1 ;BIR/LTL- ADT Admit Message builder for HL7 V 1.6; 24 Nov 95
- ;;3.0; CONTROLLED SUBSTANCES ;**30**;13 Feb 97
- ;Reference to ^HLCS(869.2 are covered by DBIA #1495
- ;Reference to ^ORD(101 are covered by DBIA #872
- ;Reference to $$EN^VAFHLPID are covered by DBIA #263
- ;
- Q:'$P(DGPMA,U,2)!(("123")'[$P(DGPMA,U,2))
- Q:'$P($G(^HLCS(869.2,+$O(^HLCS(869.2,"B","PSD-NDES HLLP",0)),200)),U)&('$P($G(^HLCS(869.2,+$O(^HLCS(869.2,"B","PSD-NDES X3.28",0)),300)),U))
- N HLMTN,HLEVN,HLFS,HLA,HL,HLQ,HLECH,PSDHL
- SERVER S EID=$O(^ORD(101,"B",$S($P(DGPMA,U,2)=1:"PSD A01 SERVER",$P(DGPMA,U,2)=2:"PSD A02 SERVER",1:"PSD A03 SERVER"),0)),INT=0
- D INIT^HLFNC2(EID,.HL,INT)
- Q:$O(HL(""))']""
- D EVN($P(DGPMA,U,2),$P(DGPMA,U))
- S HLMTN="ADT",HLEVN=1,HLFS=HL("FS"),HLECH=HL("ECH"),HLQ=""
- PID S HLA("HLS",2)=$$EN^VAFHLPID(DFN,"1,2,3,5")
- N PSDSTRN
- S PSDSTRN=HLA("HLS",2),$P(PSDSTRN,HLFS,4)=$P(HLA("HLS",2),HLFS,3)
- I $L(PSDSTRN)>245 S VAFPID(1)=$E(PSDSTRN,246,999)_$G(VAFPID(1))
- S HLA("HLS",2)=$E(PSDSTRN,1,245)
- ;
- PV1 N VAROOT,VAINDT S VAROOT="PSD",VAINDT=$P(DGPMA,U) D INP^VADPT
- S $P(HLA("HLS",3),HL("FS"),3)="I"
- S $P(HLA("HLS",3),HL("FS"),8)=""
- S $P(HLA("HLS",3),HL("FS"))="PV1"
- S $P(HLA("HLS",3),HL("FS"),4)=$P(PSD(4),U,2)_$E(HL("ECH"))_$P(PSD(5),"-")_$E(HL("ECH"))_$P(PSD(5),"-",2)
- S $P(HLA("HLS",3),HL("FS"),7)=$E(HL("ECH"))_$E(HL("ECH"))
- S $P(HLA("HLS",3),HL("FS"),8)=$P(PSD(2),U)_$E(HL("ECH"))_$$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(HLA("HLS",3),HL("FS"),7)=$P(PSD(15,4),U,2)_$E(HL("ECH"))_$E(HL("ECH"))
- SEND S HLEID=EID D GENERATE^HLMA(HLEID,"LM",1,.HLRST,"",.HL) K PSD Q
- EVN(EVENT,DATE) ;EVN Segment builder
- S HLA("HLS",1)="EVN"_HL("FS")_"A0"_EVENT_HL("FS")_$$HLDATE^HLFNC(DATE) Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDADT1 1798 printed Mar 13, 2025@20:49:40 Page 2
- PSDADT1 ;BIR/LTL- ADT Admit Message builder for HL7 V 1.6; 24 Nov 95
- +1 ;;3.0; CONTROLLED SUBSTANCES ;**30**;13 Feb 97
- +2 ;Reference to ^HLCS(869.2 are covered by DBIA #1495
- +3 ;Reference to ^ORD(101 are covered by DBIA #872
- +4 ;Reference to $$EN^VAFHLPID are covered by DBIA #263
- +5 ;
- +6 if '$PIECE(DGPMA,U,2)!(("123")'[$PIECE(DGPMA,U,2))
- QUIT
- +7 if '$PIECE($GET(^HLCS(869.2,+$ORDER(^HLCS(869.2,"B","PSD-NDES HLLP",0)),200)),U)&('$PIECE($GET(^HLCS(869.2,+$ORDER(^HLCS(869.2,"B","PSD-NDES X3.28",0)),300)),U))
- QUIT
- +8 NEW HLMTN,HLEVN,HLFS,HLA,HL,HLQ,HLECH,PSDHL
- SERVER SET EID=$ORDER(^ORD(101,"B",$SELECT($PIECE(DGPMA,U,2)=1:"PSD A01 SERVER",$PIECE(DGPMA,U,2)=2:"PSD A02 SERVER",1:"PSD A03 SERVER"),0))
- SET INT=0
- +1 DO INIT^HLFNC2(EID,.HL,INT)
- +2 if $ORDER(HL(""))']""
- QUIT
- +3 DO EVN($PIECE(DGPMA,U,2),$PIECE(DGPMA,U))
- +4 SET HLMTN="ADT"
- SET HLEVN=1
- SET HLFS=HL("FS")
- SET HLECH=HL("ECH")
- SET HLQ=""
- PID SET HLA("HLS",2)=$$EN^VAFHLPID(DFN,"1,2,3,5")
- +1 NEW PSDSTRN
- +2 SET PSDSTRN=HLA("HLS",2)
- SET $PIECE(PSDSTRN,HLFS,4)=$PIECE(HLA("HLS",2),HLFS,3)
- +3 IF $LENGTH(PSDSTRN)>245
- SET VAFPID(1)=$EXTRACT(PSDSTRN,246,999)_$GET(VAFPID(1))
- +4 SET HLA("HLS",2)=$EXTRACT(PSDSTRN,1,245)
- +5 ;
- PV1 NEW VAROOT,VAINDT
- SET VAROOT="PSD"
- SET VAINDT=$PIECE(DGPMA,U)
- DO INP^VADPT
- +1 SET $PIECE(HLA("HLS",3),HL("FS"),3)="I"
- +2 SET $PIECE(HLA("HLS",3),HL("FS"),8)=""
- +3 SET $PIECE(HLA("HLS",3),HL("FS"))="PV1"
- +4 SET $PIECE(HLA("HLS",3),HL("FS"),4)=$PIECE(PSD(4),U,2)_$EXTRACT(HL("ECH"))_$PIECE(PSD(5),"-")_$EXTRACT(HL("ECH"))_$PIECE(PSD(5),"-",2)
- +5 SET $PIECE(HLA("HLS",3),HL("FS"),7)=$EXTRACT(HL("ECH"))_$EXTRACT(HL("ECH"))
- +6 SET $PIECE(HLA("HLS",3),HL("FS"),8)=$PIECE(PSD(2),U)_$EXTRACT(HL("ECH"))_$$HLNAME^HLFNC($PIECE(PSD(2),U,2))
- +7 if $PIECE(DGPMA,U,2)=2
- Begin DoDot:1
- +8 NEW VAROOT,VAINDT
- SET VAROOT="PSD"
- SET VAINDT=$PIECE(DGPMA,U)
- DO IN5^VADPT
- +9 SET $PIECE(HLA("HLS",3),HL("FS"),7)=$PIECE(PSD(15,4),U,2)_$EXTRACT(HL("ECH"))_$EXTRACT(HL("ECH"))
- End DoDot:1
- SEND SET HLEID=EID
- DO GENERATE^HLMA(HLEID,"LM",1,.HLRST,"",.HL)
- KILL PSD
- QUIT
- EVN(EVENT,DATE) ;EVN Segment builder
- +1 SET HLA("HLS",1)="EVN"_HL("FS")_"A0"_EVENT_HL("FS")_$$HLDATE^HLFNC(DATE)
- QUIT
