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