- 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