ABME8PRV.m

ABME8PRV ; IHS/ASDST/DMJ - 837 PRV Segment 

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;Provider Information

 ;

 ; IHS/SD/SDR - v2.5 p5 - 5/17/04 - Added code for referring provider

 ;     from page 3

 ;

 ; IHS/SD/SDR - v2.5 p10 - IM17482

 ;   Added code to not print PRV if site parameter is on

 ;

EP(X,Y) ;EP - START HERE

 ;x=type

 ;y=ien

 I $G(^ABMDPARM(DUZ(2),1,19,ABMP("INS"),0))'="" S ABMR("PRV")="",ABMREC("PRV")="" Q

 I +Y=0 S Y=$P(ABMP("PRV","F",Y),"^",2)

 K ABMREC("PRV"),ABMR("PRV")

 S ABMPRVC=X

 S ABME("RTYPE")="PRV"

 D LOOP

 K ABME

 Q

LOOP ;LOOP HERE

 F I=10:10:70 D

 .D @I

 .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),ABME("RTYPE"),I)) D @(^(I))

 .I $G(ABMREC("PRV"))'="" S ABMREC("PRV")=ABMREC("PRV")_"*"

 .S ABMREC("PRV")=$G(ABMREC("PRV"))_ABMR("PRV",I)

 Q

10 ;segment

 S ABMR("PRV",10)="PRV"

 Q

20 ;PRV01 - Provider Code

 S ABMR("PRV",20)=ABMPRVC

 Q

30 ;PRV02 - Reference Identification Qualifier

 S ABMR("PRV",30)="ZZ"

 Q

40 ;PRV03 - Reference Identification

 S ABMR("PRV",40)=""

 I "AT^SU^OP^OY^PE^RF"[ABMPRVC D

 .S ABMR("PRV",40)=$$PTAX^ABMEEPRV(Y)

 I ABMPRVC="BI" D

 .S ABMR("PRV",40)=$$PTAX^ABMUTLF(DUZ(2))

 .I ABMP("VTYP")=831 S ABMR("PRV",40)="261QA1903X"

 I ABMPRVC="PT" D

 .S ABMR("PRV",40)=$$PTAX^ABMUTLF(ABMP("PAYDFN"))

 I ABMPRVC="RP" D

 .S ABMR("PRV",40)=$$PTAX^ABMUTLF(ABMP("LDFN"))

 Q

50 ;PRV04 - State or Province Code

 S ABMR("PRV",50)=""

 Q

60 ;PRV05 - Provider Specialty Information

 S ABMR("PRV",60)=""

 Q

70 ;PRV06 - Provider Organization Code

 S ABMR("PRV",70)=""

 Q

ABME8PRV  ; IHS/ASDST/DMJ - 837 PRV Segment 

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;Provider Information

 +3       ;

 +4       ; IHS/SD/SDR - v2.5 p5 - 5/17/04 - Added code for referring provider

 +5       ;     from page 3

 +6       ;

 +7       ; IHS/SD/SDR - v2.5 p10 - IM17482

 +8       ;   Added code to not print PRV if site parameter is on

 +9       ;

EP(X,Y)   ;EP - START HERE

 +1       ;x=type

 +2       ;y=ien

 +3        IF $GET(^ABMDPARM(DUZ(2),1,19,ABMP("INS"),0))'=""

               SET ABMR("PRV")=""

               SET ABMREC("PRV")=""

               QUIT 

 +4        IF +Y=0

               SET Y=$PIECE(ABMP("PRV","F",Y),"^",2)

 +5        KILL ABMREC("PRV"),ABMR("PRV")

 +6        SET ABMPRVC=X

 +7        SET ABME("RTYPE")="PRV"

 +8        DO LOOP

 +9        KILL ABME

 +10       QUIT 

LOOP      ;LOOP HERE

 +1        FOR I=10:10:70

               Begin DoDot:1

 +2                DO @I

 +3                IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),ABME("RTYPE"),I))

                       DO @(^(I))

 +4                IF $GET(ABMREC("PRV"))'=""

                       SET ABMREC("PRV")=ABMREC("PRV")_"*"

 +5                SET ABMREC("PRV")=$GET(ABMREC("PRV"))_ABMR("PRV",I)

               End DoDot:1

 +6        QUIT 

10        ;segment

 +1        SET ABMR("PRV",10)="PRV"

 +2        QUIT 

20        ;PRV01 - Provider Code

 +1        SET ABMR("PRV",20)=ABMPRVC

 +2        QUIT 

30        ;PRV02 - Reference Identification Qualifier

 +1        SET ABMR("PRV",30)="ZZ"

 +2        QUIT 

40        ;PRV03 - Reference Identification

 +1        SET ABMR("PRV",40)=""

 +2        IF "AT^SU^OP^OY^PE^RF"[ABMPRVC

               Begin DoDot:1

 +3                SET ABMR("PRV",40)=$$PTAX^ABMEEPRV(Y)

               End DoDot:1

 +4        IF ABMPRVC="BI"

               Begin DoDot:1

 +5                SET ABMR("PRV",40)=$$PTAX^ABMUTLF(DUZ(2))

 +6                IF ABMP("VTYP")=831

                       SET ABMR("PRV",40)="261QA1903X"

               End DoDot:1

 +7        IF ABMPRVC="PT"

               Begin DoDot:1

 +8                SET ABMR("PRV",40)=$$PTAX^ABMUTLF(ABMP("PAYDFN"))

               End DoDot:1

 +9        IF ABMPRVC="RP"

               Begin DoDot:1

 +10               SET ABMR("PRV",40)=$$PTAX^ABMUTLF(ABMP("LDFN"))

               End DoDot:1

 +11       QUIT 

50        ;PRV04 - State or Province Code

 +1        SET ABMR("PRV",50)=""

 +2        QUIT 

60        ;PRV05 - Provider Specialty Information

 +1        SET ABMR("PRV",60)=""

 +2        QUIT 

70        ;PRV06 - Provider Organization Code

 +1        SET ABMR("PRV",70)=""

 +2        QUIT