| 1 | VAFHLPD1 ;ALB/RKS,PHH-HL7 PD1 SEGMENT; 26 July 01 ; 3/9/2004 2:09PM
|
|---|
| 2 | ;;5.3;Registration;**91,160,229,149,409,389,568**;Jun 06, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | EN(DFN,VAFSTR) ;Main enty point for building of PD1 Segment
|
|---|
| 6 | ;
|
|---|
| 7 | ;Input : DFN - Pointer to entry in PATIENT fiel (#2)
|
|---|
| 8 | ; VAFSTR - String of fields requested separated by commas
|
|---|
| 9 | ; All variables defined by call to INIT^HLFNC2()
|
|---|
| 10 | ;Output : PD1 segment
|
|---|
| 11 | ;
|
|---|
| 12 | N FS,CS,SS,VAFPD1
|
|---|
| 13 | S FS=HL("FS"),CS=$E(HL("ECH")),SS=$E(HL("ECH"),4)
|
|---|
| 14 | I $G(DFN)="" Q "PD1"_FS
|
|---|
| 15 | I $G(^DPT(DFN,0))="" Q "PD1"_FS
|
|---|
| 16 | S:($G(VAFSTR)="") VAFSTR="3,4"
|
|---|
| 17 | S VAFSTR=","_VAFSTR_","
|
|---|
| 18 | S VAFPD1="PD1"_FS
|
|---|
| 19 | ;Patient CMOR (as defined by CIRN)
|
|---|
| 20 | I VAFSTR[",3,",('$D(^PPP(1020.128,"AC",$P($$SITE^VASITE,"^",3)))) D
|
|---|
| 21 | . ;CIRN check
|
|---|
| 22 | . I $T(CHANGE^MPIF001)']"" S $P(VAFPD1,FS,4)=HL("Q")_CS_CS_HL("Q") Q
|
|---|
| 23 | . N DIC,DR,DA,DIQ,PTR4,SITENAME,SITENUM,PT,INST
|
|---|
| 24 | . S (SITENAME,SITENUM)=""
|
|---|
| 25 | . S DIC=2,DR="991.03",DA=DFN,DIQ="PT",DIQ(0)="IE"
|
|---|
| 26 | . D EN^DIQ1
|
|---|
| 27 | . S PTR4=$G(PT(2,DFN,991.03,"I"))
|
|---|
| 28 | . ;IF CMOR DEFINED
|
|---|
| 29 | . I PTR4]"" D
|
|---|
| 30 | . . S DIC=4,DR="99",DA=PTR4,DIQ="INST",DIQ(0)="IE"
|
|---|
| 31 | . . D EN^DIQ1
|
|---|
| 32 | . . S SITENAME=$G(PT(2,DFN,991.03,"E"))
|
|---|
| 33 | . . S SITENUM=$G(INST(4,PTR4,99,"E"))
|
|---|
| 34 | . . Q
|
|---|
| 35 | . S $P(VAFPD1,FS,4)=$$HLQ^VAFHUTL(SITENAME)_CS_CS_$$HLQ^VAFHUTL(SITENUM)
|
|---|
| 36 | . Q
|
|---|
| 37 | ;Primary Care Provider (as defined by PCMM)
|
|---|
| 38 | I VAFSTR[",4," D
|
|---|
| 39 | . N PTR200,VAFHLTMP,PCPRV,X
|
|---|
| 40 | . ;Get provider (pointer to NEW PERSON file)
|
|---|
| 41 | . S PTR200=+$$PCPRACT^DGSDUTL(DFN)
|
|---|
| 42 | . I PTR200<1 S $P(VAFPD1,FS,5)=HL("Q") Q
|
|---|
| 43 | . ;Get External Provider ID
|
|---|
| 44 | . D PERSON^VAFHLRO3(PTR200,"VAFHLTMP",HL("Q"))
|
|---|
| 45 | . I ('$D(VAFHLTMP)) S $P(VAFPD1,FS,5)=HL("Q") Q
|
|---|
| 46 | . S PCPRV=VAFHLTMP(1,1,1)_SS_VAFHLTMP(1,1,2)
|
|---|
| 47 | . F X=2:1:7 S $P(PCPRV,CS,X)=HL("Q")
|
|---|
| 48 | . S $P(PCPRV,CS,8)=VAFHLTMP(1,8)
|
|---|
| 49 | . S $P(VAFPD1,FS,5)=PCPRV
|
|---|
| 50 | . Q
|
|---|
| 51 | ;Done
|
|---|
| 52 | Q VAFPD1
|
|---|
