| 1 | PSDADT1 ;BIR/LTL- ADT Admit Message builder for HL7 V 1.6; 24 Nov 95
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;**30**;13 Feb 97
|
|---|
| 3 | ;Reference to ^HLCS(869.2 are covered by DBIA #1495
|
|---|
| 4 | ;Reference to ^ORD(101 are covered by DBIA #872
|
|---|
| 5 | ;Reference to $$EN^VAFHLPID are covered by DBIA #263
|
|---|
| 6 | ;
|
|---|
| 7 | Q:'$P(DGPMA,U,2)!(("123")'[$P(DGPMA,U,2))
|
|---|
| 8 | 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))
|
|---|
| 9 | N HLMTN,HLEVN,HLFS,HLA,HL,HLQ,HLECH,PSDHL
|
|---|
| 10 | 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
|
|---|
| 11 | D INIT^HLFNC2(EID,.HL,INT)
|
|---|
| 12 | Q:$O(HL(""))']""
|
|---|
| 13 | D EVN($P(DGPMA,U,2),$P(DGPMA,U))
|
|---|
| 14 | S HLMTN="ADT",HLEVN=1,HLFS=HL("FS"),HLECH=HL("ECH"),HLQ=""
|
|---|
| 15 | PID S HLA("HLS",2)=$$EN^VAFHLPID(DFN,"1,2,3,5")
|
|---|
| 16 | N PSDSTRN
|
|---|
| 17 | S PSDSTRN=HLA("HLS",2),$P(PSDSTRN,HLFS,4)=$P(HLA("HLS",2),HLFS,3)
|
|---|
| 18 | I $L(PSDSTRN)>245 S VAFPID(1)=$E(PSDSTRN,246,999)_$G(VAFPID(1))
|
|---|
| 19 | S HLA("HLS",2)=$E(PSDSTRN,1,245)
|
|---|
| 20 | ;
|
|---|
| 21 | PV1 N VAROOT,VAINDT S VAROOT="PSD",VAINDT=$P(DGPMA,U) D INP^VADPT
|
|---|
| 22 | S $P(HLA("HLS",3),HL("FS"),3)="I"
|
|---|
| 23 | S $P(HLA("HLS",3),HL("FS"),8)=""
|
|---|
| 24 | S $P(HLA("HLS",3),HL("FS"))="PV1"
|
|---|
| 25 | 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)
|
|---|
| 26 | S $P(HLA("HLS",3),HL("FS"),7)=$E(HL("ECH"))_$E(HL("ECH"))
|
|---|
| 27 | S $P(HLA("HLS",3),HL("FS"),8)=$P(PSD(2),U)_$E(HL("ECH"))_$$HLNAME^HLFNC($P(PSD(2),U,2))
|
|---|
| 28 | D:$P(DGPMA,U,2)=2
|
|---|
| 29 | .N VAROOT,VAINDT S VAROOT="PSD",VAINDT=$P(DGPMA,U) D IN5^VADPT
|
|---|
| 30 | .S $P(HLA("HLS",3),HL("FS"),7)=$P(PSD(15,4),U,2)_$E(HL("ECH"))_$E(HL("ECH"))
|
|---|
| 31 | SEND S HLEID=EID D GENERATE^HLMA(HLEID,"LM",1,.HLRST,"",.HL) K PSD Q
|
|---|
| 32 | EVN(EVENT,DATE) ;EVN Segment builder
|
|---|
| 33 | S HLA("HLS",1)="EVN"_HL("FS")_"A0"_EVENT_HL("FS")_$$HLDATE^HLFNC(DATE) Q
|
|---|
