Routine: BARVPM

BARVPM ; IHS/SD/LSL - MAP VP FIELDS TO TARGET FILES DEC 4,1996 ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**16,23**;OCT 26, 2005

;;

 ; IHS/SD/LSL - 02/25/2002 - V1.6 Patch 2 - NOIS LTA-0202-160141

 ;     Modified VALI line tag to find NON-BENEFICIARY insurer type on

 ;     A/R Patient accounts.  Similar to what is done in VAL.

 ; M2 TMM 01/13/2010 (BAR 1.8*16) - HEAT 8163. ResolveD error <SYNTAX>EN+21^BARPTR

 ; MAR 2013 P.OTTIS ADDED NEW VA billing

 ; *********************************************************************

VAL(X) ;EP

 N Y,V,P,F,I,Z

 ; P-Pt value; F-Field

 ; V-VP File, Y-Internal of .01

 ; L-Line

 S Y=$P($G(^BARAC(DUZ(2),D0,0)),U)

 S P=$P(Y,";"),V=$P(Y,";",2)

 ; Resolve/Redirect remote pointers

 I V="AUPNPAT(" S V="DPT("

 F I=1:1 S L=$P($T(FILES+I),";;",2,999) Q:L=""  Q:(V=$P(L,U))

 I L="" Q ""

 S L=$P(L,U,2),F=$P(L,";",X)

 I X'=8,F="" Q ""

 S V="^"_V

 ;I V="^DPT(",X=8 D                              ;M2*DEL*TMM

 I "^DPT(_^VA(200,"[V,X=8 D                      ;M2*ADD*TMM

 . S V="^AUTNINS("

 . S P=$O(^AUTNINS("B","NON-BENEFICIARY PATIENT",0))

 . S F=".211" ;P.OTT

 S Z=$$VAL^XBDIQ1(V,P,F)

Q Z

 ; *********************************************************************

VALI(X) ;EP

 N Y,V,P,F,I,Z

 ;I DUZ=838 W !,"INPUT: D0=",D0

 ; P-Pt value; F-Field

 ; V-VP File, Y-Internal of .01

 ; L-Line

 S Y=$P($G(^BARAC(DUZ(2),D0,0)),U)

 S P=$P(Y,";"),V=$P(Y,";",2)

 ; Resolve/Redirect remote pointers

 I V="AUPNPAT(" S V="DPT("

 F I=1:1 S L=$P($T(FILES+I),";;",2,999) Q:L=""  Q:(V=$P(L,U))

 I L="" Q ""

 S L=$P(L,U,2),F=$P(L,";",X)

 I X'=8,F="" Q ""

 S V="^"_V

 ;I V="^DPT(",X=8 D                              ;M2*DEL*TMM

 I "^DPT(_^VA(200,"[V,X=8 D                      ;M2*ADD*TMM

 . S V="^AUTNINS("

 . S P=$O(^AUTNINS("B","NON-BENEFICIARY PATIENT",0))

 . S F=".211" ;P.OTT

 S Z=$$VALI^XBDIQ1(V,P,F)

 I X=8 D  Q Z ;P.OTT

 . I Z="" Q

 . S Z=$P($G(^AUTTINTY(Z,0)),"^",2) ;="3P LIABILITY^T"

Q Z

 ; *********************************************************************

 ; dd field modified ($T ref)

FILES ;global^

 ;;AUTNINS(^.02;;;.03;.04;.05;.06;.211

 ;;VA(200,^.111;.112;.113;.114;.115;.116;.131

 ;;DPT(^.111;.112;.113;.114;.115;.116;.131

 ;;AUTTVNDR(^1306;1310;;1307;1308;1309;1109

END ;;

DIC() ;EP

 Q $P($$VALI^XBDIQ1(90050.02,D0,.01),";",2)

 ; *********************************************************************

IEN() ;EP

 Q +$$VALI^XBDIQ1(90050.02,D0,.01)

 ; *********************************************************************

NUM() ;EP

 S Z="^"_$$DIC^BARVPM()_"0)"

 S Z=$P(@Z,"^",2),Z=+Z

Q Z

 ; *********************************************************************

 ; dd field modified ($T ref)

DOC ;document pieces

1 ;;STREET ADDRESS 1

2 ;;STREET ADDRESS 2

3 ;;STREET ADDRESS 3

4 ;;CITY

5 ;;STATE

6 ;;ZIP

7 ;;PHONE

8 ;;VP INSURER TYPE

BARVPM    ; IHS/SD/LSL - MAP VP FIELDS TO TARGET FILES DEC 4,1996 ;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**16,23**;OCT 26, 2005

 +2       ;;

 +3       ; IHS/SD/LSL - 02/25/2002 - V1.6 Patch 2 - NOIS LTA-0202-160141

 +4       ;     Modified VALI line tag to find NON-BENEFICIARY insurer type on

 +5       ;     A/R Patient accounts.  Similar to what is done in VAL.

 +6       ;

 +7       ; M2 TMM 01/13/2010 (BAR 1.8*16) - HEAT 8163. ResolveD error <SYNTAX>EN+21^BARPTR

 +8       ; MAR 2013 P.OTTIS ADDED NEW VA billing

 +9       ; *********************************************************************

 +10      ;

VAL(X)    ;EP

 +1        NEW Y,V,P,F,I,Z

 +2       ; P-Pt value; F-Field

 +3       ; V-VP File, Y-Internal of .01

 +4       ; L-Line

 +5        SET Y=$PIECE($GET(^BARAC(DUZ(2),D0,0)),U)

 +6        SET P=$PIECE(Y,";")

           SET V=$PIECE(Y,";",2)

 +7       ; Resolve/Redirect remote pointers

 +8        IF V="AUPNPAT("

               SET V="DPT("

 +9       ;

 +10       FOR I=1:1

               SET L=$PIECE($TEXT(FILES+I),";;",2,999)

               IF L=""

                   QUIT

               IF (V=$PIECE(L,U))

                   QUIT

 +11       IF L=""

               QUIT ""

 +12       SET L=$PIECE(L,U,2)

           SET F=$PIECE(L,";",X)

 +13       IF X'=8

               IF F=""

                   QUIT ""

 +14       SET V="^"_V

 +15      ;I V="^DPT(",X=8 D                              ;M2*DEL*TMM

 +16      ;M2*ADD*TMM

           IF "^DPT(_^VA(200,"[V

               IF X=8

                   Begin DoDot:1

 +17                   SET V="^AUTNINS("

 +18                   SET P=$ORDER(^AUTNINS("B","NON-BENEFICIARY PATIENT",0))

 +19      ;P.OTT

                       SET F=".211"

                   End DoDot:1

 +20       SET Z=$$VAL^XBDIQ1(V,P,F)

 +21       QUIT Z

 +22      ; *********************************************************************

 +23      ;

VALI(X)   ;EP

 +1        NEW Y,V,P,F,I,Z

 +2       ;I DUZ=838 W !,"INPUT: D0=",D0

 +3       ; P-Pt value; F-Field

 +4       ; V-VP File, Y-Internal of .01

 +5       ; L-Line

 +6        SET Y=$PIECE($GET(^BARAC(DUZ(2),D0,0)),U)

 +7        SET P=$PIECE(Y,";")

           SET V=$PIECE(Y,";",2)

 +8       ; Resolve/Redirect remote pointers

 +9        IF V="AUPNPAT("

               SET V="DPT("

 +10      ;

 +11       FOR I=1:1

               SET L=$PIECE($TEXT(FILES+I),";;",2,999)

               IF L=""

                   QUIT

               IF (V=$PIECE(L,U))

                   QUIT

 +12       IF L=""

               QUIT ""

 +13       SET L=$PIECE(L,U,2)

           SET F=$PIECE(L,";",X)

 +14       IF X'=8

               IF F=""

                   QUIT ""

 +15       SET V="^"_V

 +16      ;I V="^DPT(",X=8 D                              ;M2*DEL*TMM

 +17      ;M2*ADD*TMM

           IF "^DPT(_^VA(200,"[V

               IF X=8

                   Begin DoDot:1

 +18                   SET V="^AUTNINS("

 +19                   SET P=$ORDER(^AUTNINS("B","NON-BENEFICIARY PATIENT",0))

 +20      ;P.OTT

                       SET F=".211"

                   End DoDot:1

 +21       SET Z=$$VALI^XBDIQ1(V,P,F)

 +22      ;P.OTT

           IF X=8

               Begin DoDot:1

 +23               IF Z=""

                       QUIT

 +24      ;="3P LIABILITY^T"

                   SET Z=$PIECE($GET(^AUTTINTY(Z,0)),"^",2)

               End DoDot:1

               QUIT Z

 +25       QUIT Z

 +26      ; *********************************************************************

 +27      ;

 +28      ; dd field modified ($T ref)

FILES     ;global^

 +1       ;;AUTNINS(^.02;;;.03;.04;.05;.06;.211

 +2       ;;VA(200,^.111;.112;.113;.114;.115;.116;.131

 +3       ;;DPT(^.111;.112;.113;.114;.115;.116;.131

 +4       ;;AUTTVNDR(^1306;1310;;1307;1308;1309;1109

END       ;;

DIC()     ;EP

 +1        QUIT $PIECE($$VALI^XBDIQ1(90050.02,D0,.01),";",2)

 +2       ; *********************************************************************

 +3       ;

IEN()     ;EP

 +1        QUIT +$$VALI^XBDIQ1(90050.02,D0,.01)

 +2       ; *********************************************************************

 +3       ;

NUM()     ;EP

 +1        SET Z="^"_$$DIC^BARVPM()_"0)"

 +2        SET Z=$PIECE(@Z,"^",2)

           SET Z=+Z

 +3        QUIT Z

 +4       ; *********************************************************************

 +5       ;

 +6       ; dd field modified ($T ref)

DOC       ;document pieces

1         ;;STREET ADDRESS 1

2         ;;STREET ADDRESS 2

3         ;;STREET ADDRESS 3

4         ;;CITY

5         ;;STATE

6         ;;ZIP

7         ;;PHONE

8         ;;VP INSURER TYPE

BARVPM.m