VAFHLPD1.m

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,1015**;Jun 06, 1996;Build 21

 ;

 ;

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

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,1015**;Jun 06, 1996;Build 21

 +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