BAR3PINQ.m

BAR3PINQ ; IHS/SD/LSL - Inquire into 3P Bill file from A/R Bill file DEC 4,1996 ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**16**;OCT 22,2008

 ;

 ; IHS/SD/LSL - 11/25/02 - V1.7 - NHA-0601-180049

 ;      Modified to search for bill in 3PB correctly (majority of the

 ;      routine has changed)

 ;

 ; M2 TMM 01/12/2010  HEAT 8727, Resolve error when 3P Claim does not exist.

 ;                    This scenario occurs when POS incorrectly creates claims 

 ;                    in ^ABMDBILL under individual site rather than the parent 

 ;                    facility and there are no corresponding claims in ^ABMDCLM.

 ;                         $ZE= <UNDEFINED>EN+7^DIC *DINDEX("#")

 ;                         . S:DINDEX("#")>1 DIC(0)=$TR(DIC(0),"M") Q

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

 ;

 ;Computed field routine utilization

 ; $$VAL^BAR3PINQ(A/R IEN,"B"-bill "C"-claim,field number)

 ; $$VALI^BAR3PINQ(A/R IEN,"B"-bill "C"-claim,field number)

 Q

VAL(BARDA,BARFILE,BARFLD) ;EP - Return field from remote file

 N BARBL,BARDUZ2,BARX,Y,BAR3PBIL

 S BARX="",BARDUZ2=0

 D ENP^XBDIQ1(90050.01,BARDA,".01;17;108","BARBL(","I")

 S BAR3PBIL=$$FIND3PB^BARUTL(DUZ(2),BARDA)

 I BAR3PBIL="" G QUIT

 ;changes for supportability 

 I BARFILE'="B" G C

 ;

 ; -------------------------------

B ;EP - process "B"ill

 S BARDUZ2=DUZ(2)

 S DUZ(2)=$P(BAR3PBIL,",")

 S BARX=$$GET1^DIQ(9002274.4,$P(BAR3PBIL,",",2),BARFLD)

 S DUZ(2)=BARDUZ2

 G QUIT

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

 ;

C ;EP - process "C"laim information

 N BARTMP1,BARTMP2                              ;M2*ADD*TMM

 S BARTMP1=$P(BAR3PBIL,",",1)       ;3PB DUZ2   ;M2*ADD*TMM

 S BARTMP2=$P(BAR3PBIL,",",2)       ;3PB IEN    ;M2*ADD*TMM

 I '$D(^ABMDCLM(BARTMP1,BARTMP2)) G QUIT        ;M2*ADD*TMM

 S BARDUZ2=DUZ(2)

 S DUZ(2)=$P(BAR3PBIL,",")

 S DIC=9002274.3

 S X=+BARBL(.01)

 S DIC(0)="X"

 D ^DIC

 S:Y>0 BARX=$$GET1^DIQ(9002274.3,+Y,BARFLD)

 S DUZ(2)=BARDUZ2

QUIT ;**

 K BAR3PDA

 Q BARX

BAR3PINQ  ; IHS/SD/LSL - Inquire into 3P Bill file from A/R Bill file DEC 4,1996 ;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**16**;OCT 22,2008

 +2       ;

 +3       ; IHS/SD/LSL - 11/25/02 - V1.7 - NHA-0601-180049

 +4       ;      Modified to search for bill in 3PB correctly (majority of the

 +5       ;      routine has changed)

 +6       ;

 +7       ; M2 TMM 01/12/2010  HEAT 8727, Resolve error when 3P Claim does not exist.

 +8       ;                    This scenario occurs when POS incorrectly creates claims 

 +9       ;                    in ^ABMDBILL under individual site rather than the parent 

 +10      ;                    facility and there are no corresponding claims in ^ABMDCLM.

 +11      ;                         $ZE= <UNDEFINED>EN+7^DIC *DINDEX("#")

 +12      ;                         . S:DINDEX("#")>1 DIC(0)=$TR(DIC(0),"M") Q

 +13      ; ********************************************************************

 +14      ;

 +15      ;Computed field routine utilization

 +16      ; $$VAL^BAR3PINQ(A/R IEN,"B"-bill "C"-claim,field number)

 +17      ; $$VALI^BAR3PINQ(A/R IEN,"B"-bill "C"-claim,field number)

 +18       QUIT 

VAL(BARDA,BARFILE,BARFLD) ;EP - Return field from remote file

 +1        NEW BARBL,BARDUZ2,BARX,Y,BAR3PBIL

 +2        SET BARX=""

           SET BARDUZ2=0

 +3        DO ENP^XBDIQ1(90050.01,BARDA,".01;17;108","BARBL(","I")

 +4        SET BAR3PBIL=$$FIND3PB^BARUTL(DUZ(2),BARDA)

 +5        IF BAR3PBIL=""

               GOTO QUIT

 +6       ;changes for supportability 

 +7        IF BARFILE'="B"

               GOTO C

 +8       ;

 +9       ; -------------------------------

B         ;EP - process "B"ill

 +1        SET BARDUZ2=DUZ(2)

 +2        SET DUZ(2)=$PIECE(BAR3PBIL,",")

 +3        SET BARX=$$GET1^DIQ(9002274.4,$PIECE(BAR3PBIL,",",2),BARFLD)

 +4        SET DUZ(2)=BARDUZ2

 +5        GOTO QUIT

 +6       ; *********************************************************************

 +7       ;

C         ;EP - process "C"laim information

 +1       ;M2*ADD*TMM

           NEW BARTMP1,BARTMP2

 +2       ;3PB DUZ2   ;M2*ADD*TMM

           SET BARTMP1=$PIECE(BAR3PBIL,",",1)

 +3       ;3PB IEN    ;M2*ADD*TMM

           SET BARTMP2=$PIECE(BAR3PBIL,",",2)

 +4       ;M2*ADD*TMM

           IF '$DATA(^ABMDCLM(BARTMP1,BARTMP2))

               GOTO QUIT

 +5        SET BARDUZ2=DUZ(2)

 +6        SET DUZ(2)=$PIECE(BAR3PBIL,",")

 +7        SET DIC=9002274.3

 +8        SET X=+BARBL(.01)

 +9        SET DIC(0)="X"

 +10       DO ^DIC

 +11       IF Y>0

               SET BARX=$$GET1^DIQ(9002274.3,+Y,BARFLD)

 +12       SET DUZ(2)=BARDUZ2

QUIT      ;**

 +1        KILL BAR3PDA

 +2        QUIT BARX