- FBPAID2 ;AISC - SERVER ALERT MESSAGES ;6/1/1999
- ;;3.5;FEE BASIS;**4**;JAN 30, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- S FBN=0,XQSTXT(FBN)=""
- ;process those payments that have the amount paid changed in FMS
- I $D(^TMP("FBERR",$J,4)) D
- .S FBN=FBN+1,XQSTXT(FBN)=" The 'AMOUNT PAID' has been altered on the Fee Payment Voucher Document",FBN=FBN+1,XQSTXT(FBN)=" in FMS for the following payments:",FBN=FBN+1,XQSTXT(FBN)=""
- .S I=0 F S I=$O(^TMP("FBERR",$J,4,I)) Q:'I S FBI=$P(^(I),U,2,99) D @$P(FBI,U)
- I FBN'>3 K XQSTXT S FBN=0,XQSTXT(FBN)=""
- I FBN>3 S FBN=FBN+1,XQSTXT(FBN)=" >>> For detailed payment information use the appropriate payment output. <<<",FBN=FBN+1,XQSTXT(FBN)=""
- ;process those payments that have been cancelled and require human int.
- S FBNH=FBN
- I $D(^TMP("FBERR",$J,5)) D
- .S FBN=FBN+1,XQSTXT(FBN)=" Payment has been cancelled for the following line items:",FBN=FBN+1,XQSTXT(FBN)=""
- .S I=0 F S I=$O(^TMP("FBERR",$J,5,I)) Q:'I S FBI=$P(^(I),U,2,99) D @$P(FBI,U)
- I FBN'=FBNH&(FBN-FBNH'>3) F I=FBNH:1:FBN K XQSTXT(I)
- I FBN-FBNH>3 S FBN=FBN+1,XQSTXT(FBN)=" >>> For detailed check information use the Check Display output. <<<",FBN=FBN+1,XQSTXT(FBN)=""
- D EXIT^FBMRASV2 K FBN,I,D,FBI,FBNH
- Q
- 3 ;write outpatient medical payment (162)
- S D(3)=+$P(FBI,U,2),D(2)=+$P(FBI,U,3),D(1)=+$P(FBI,U,4),D=+$P(FBI,U,5)
- D OUTP(+FBI,.D)
- K D,FBI
- Q
- ;
- 5 ;write pharmacy payments
- S D(1)=+$P(FBI,U,2),D=+$P(FBI,U,3)
- D OUTP(+FBI,.D)
- K D,FBI
- Q
- ;
- 9 ;write inpatient payments
- S D=+$P(FBI,U,2)
- D OUTP(+FBI,.D)
- K D,FBI
- Q
- T ;write travel payments
- S D(1)=+$P(FBI,U,2),D=+$P(FBI,U,3)
- D OUTP($P(FBI,U),.D)
- K D,FBI
- Q
- Q
- OUTP(X,Y) ;X=fee program
- ;y=ien array of payment record
- I X=3,$D(^FBAAC(D(3),1,D(2),1,D(1),1,D,0)) S D(0)=^(0),D(4)=$G(^(2)) I $P(D(4),U,3)]"" S FBN=FBN+1 D
- . S XQSTXT(FBN)="Check Number: "_$P(D(4),U,3)_$S($P(D(0),U,20)'="R":" to "_$E($$VEN^FBUCUTL(D(2)),1,30),1:"")_" for "_$E($$VET^FBUCUTL(D(3)),1,30)_" - "_$$SSN^FBAAUTL(D(3),1)
- . S FBN=FBN+1,XQSTXT(FBN)=" CPT: "_$$CPT^FBAAUTL4($P(D(0),U))_" Date of Service: "_$$DATX^FBAAUTL($P($G(^FBAAC(D(3),1,D(2),1,D(1),0)),U))
- . S XQSTXT(FBN)=XQSTXT(FBN)_" Invoice Number: "_$P($G(D(0)),U,16)
- ;
- I X=5,$D(^FBAA(162.1,D(1),"RX",D,0)) S D(0)=^(0),D(2)=^(2) I $P(D(2),U,10)]"" S FBN=FBN+1 D
- . S XQSTXT(FBN)="Check Number: "_$P(D(2),U,10)_$S($P(D(0),U,20)'="R":" to "_$E($$VEN^FBUCUTL(+$P(^FBAA(162.1,D(1),0),U,4)),1,30),1:"")_" for "_$E($$VET^FBUCUTL(+$P(D(0),U,5)),1,30)_" - "_$$SSN^FBAAUTL(+$P(D(0),U,5),1)
- . S FBN=FBN+1,XQSTXT(FBN)=" RX#: "_$P(D(0),U)_" Date of Service: "_$$DATX^FBAAUTL($P(D(0),U,3))_" Invoice Number: "_$P(^FBAA(162.1,+D(1),0),U)
- ;
- I X=9,$D(^FBAAI(D,0)) S D(0)=^(0),D(2)=$G(^(2)) I $P(D(2),U,4)]"" S FBN=FBN+1 D
- . S XQSTXT(FBN)="Check Number: "_$P(D(2),U,4)_$S($P(D(0),U,13)'="R":" to "_$E($$VEN^FBUCUTL(+$P(D(0),U,3)),1,30),1:"")_" for "_$E($$VET^FBUCUTL(+$P(D(0),U,4)),1,30)_" - "_$$SSN^FBAAUTL(+$P(D(0),U,4),1)
- . S FBN=FBN+1,XQSTXT(FBN)=" From Date: "_$$DATX^FBAAUTL($P(D(0),U,6))_" To Date: "_$$DATX^FBAAUTL($P(D(0),U,7))_" Invoice Number: "_$P(D(0),U)
- ;
- I X="T",$D(^FBAAC(D(1),3,D,0)) S D(0)=^(0) I $P(D(0),U,7)]"" S FBN=FBN+1 D
- . S XQSTXT(FBN)="Check Number: "_$P(D(0),U,7)_" to "_$E($$VET^FBUCUTL(+D(1)),1,30)_" - "_$$SSN^FBAAUTL(+D(1),1)_" for travel on"
- . S FBN=FBN+1,XQSTXT(FBN)=" Date: "_$$DATX^FBAAUTL($P(D(0),U))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBPAID2 3467 printed Mar 13, 2025@21:04:18 Page 2
- FBPAID2 ;AISC - SERVER ALERT MESSAGES ;6/1/1999
- +1 ;;3.5;FEE BASIS;**4**;JAN 30, 1995
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 SET FBN=0
- SET XQSTXT(FBN)=""
- +4 ;process those payments that have the amount paid changed in FMS
- +5 IF $DATA(^TMP("FBERR",$JOB,4))
- Begin DoDot:1
- +6 SET FBN=FBN+1
- SET XQSTXT(FBN)=" The 'AMOUNT PAID' has been altered on the Fee Payment Voucher Document"
- SET FBN=FBN+1
- SET XQSTXT(FBN)=" in FMS for the following payments:"
- SET FBN=FBN+1
- SET XQSTXT(FBN)=""
- +7 SET I=0
- FOR
- SET I=$ORDER(^TMP("FBERR",$JOB,4,I))
- if 'I
- QUIT
- SET FBI=$PIECE(^(I),U,2,99)
- DO @$PIECE(FBI,U)
- End DoDot:1
- +8 IF FBN'>3
- KILL XQSTXT
- SET FBN=0
- SET XQSTXT(FBN)=""
- +9 IF FBN>3
- SET FBN=FBN+1
- SET XQSTXT(FBN)=" >>> For detailed payment information use the appropriate payment output. <<<"
- SET FBN=FBN+1
- SET XQSTXT(FBN)=""
- +10 ;process those payments that have been cancelled and require human int.
- +11 SET FBNH=FBN
- +12 IF $DATA(^TMP("FBERR",$JOB,5))
- Begin DoDot:1
- +13 SET FBN=FBN+1
- SET XQSTXT(FBN)=" Payment has been cancelled for the following line items:"
- SET FBN=FBN+1
- SET XQSTXT(FBN)=""
- +14 SET I=0
- FOR
- SET I=$ORDER(^TMP("FBERR",$JOB,5,I))
- if 'I
- QUIT
- SET FBI=$PIECE(^(I),U,2,99)
- DO @$PIECE(FBI,U)
- End DoDot:1
- +15 IF FBN'=FBNH&(FBN-FBNH'>3)
- FOR I=FBNH:1:FBN
- KILL XQSTXT(I)
- +16 IF FBN-FBNH>3
- SET FBN=FBN+1
- SET XQSTXT(FBN)=" >>> For detailed check information use the Check Display output. <<<"
- SET FBN=FBN+1
- SET XQSTXT(FBN)=""
- +17 DO EXIT^FBMRASV2
- KILL FBN,I,D,FBI,FBNH
- +18 QUIT
- 3 ;write outpatient medical payment (162)
- +1 SET D(3)=+$PIECE(FBI,U,2)
- SET D(2)=+$PIECE(FBI,U,3)
- SET D(1)=+$PIECE(FBI,U,4)
- SET D=+$PIECE(FBI,U,5)
- +2 DO OUTP(+FBI,.D)
- +3 KILL D,FBI
- +4 QUIT
- +5 ;
- 5 ;write pharmacy payments
- +1 SET D(1)=+$PIECE(FBI,U,2)
- SET D=+$PIECE(FBI,U,3)
- +2 DO OUTP(+FBI,.D)
- +3 KILL D,FBI
- +4 QUIT
- +5 ;
- 9 ;write inpatient payments
- +1 SET D=+$PIECE(FBI,U,2)
- +2 DO OUTP(+FBI,.D)
- +3 KILL D,FBI
- +4 QUIT
- T ;write travel payments
- +1 SET D(1)=+$PIECE(FBI,U,2)
- SET D=+$PIECE(FBI,U,3)
- +2 DO OUTP($PIECE(FBI,U),.D)
- +3 KILL D,FBI
- +4 QUIT
- +5 QUIT
- OUTP(X,Y) ;X=fee program
- +1 ;y=ien array of payment record
- +2 IF X=3
- IF $DATA(^FBAAC(D(3),1,D(2),1,D(1),1,D,0))
- SET D(0)=^(0)
- SET D(4)=$GET(^(2))
- IF $PIECE(D(4),U,3)]""
- SET FBN=FBN+1
- Begin DoDot:1
- +3 SET XQSTXT(FBN)="Check Number: "_$PIECE(D(4),U,3)_$SELECT($PIECE(D(0),U,20)'="R":" to "_$EXTRACT($$VEN^FBUCUTL(D(2)),1,30),1:"")_" for "_$EXTRACT($$VET^FBUCUTL(D(3)),1,30)_" - "_$$SSN^FBAAUTL(D(3),1)
- +4 SET FBN=FBN+1
- SET XQSTXT(FBN)=" CPT: "_$$CPT^FBAAUTL4($PIECE(D(0),U))_" Date of Service: "_$$DATX^FBAAUTL($PIECE($GET(^FBAAC(D(3),1,D(2),1,D(1),0)),U))
- +5 SET XQSTXT(FBN)=XQSTXT(FBN)_" Invoice Number: "_$PIECE($GET(D(0)),U,16)
- End DoDot:1
- +6 ;
- +7 IF X=5
- IF $DATA(^FBAA(162.1,D(1),"RX",D,0))
- SET D(0)=^(0)
- SET D(2)=^(2)
- IF $PIECE(D(2),U,10)]""
- SET FBN=FBN+1
- Begin DoDot:1
- +8 SET XQSTXT(FBN)="Check Number: "_$PIECE(D(2),U,10)_$SELECT($PIECE(D(0),U,20)'="R":" to "_$EXTRACT($$VEN^FBUCUTL(+$PIECE(^FBAA(162.1,D(1),0),U,4)),1,30),1:"")_" for "_$EXTRACT($$VET^FBUCUTL(+$PIECE(D(0),U,5)),1,30)_" - "_$$SSN^FBA
- AUTL(+...
- ... $PIECE(D(0),U,5),1)
- +9 SET FBN=FBN+1
- SET XQSTXT(FBN)=" RX#: "_$PIECE(D(0),U)_" Date of Service: "_$$DATX^FBAAUTL($PIECE(D(0),U,3))_" Invoice Number: "_$PIECE(^FBAA(162.1,+D(1),0),U)
- End DoDot:1
- +10 ;
- +11 IF X=9
- IF $DATA(^FBAAI(D,0))
- SET D(0)=^(0)
- SET D(2)=$GET(^(2))
- IF $PIECE(D(2),U,4)]""
- SET FBN=FBN+1
- Begin DoDot:1
- +12 SET XQSTXT(FBN)="Check Number: "_$PIECE(D(2),U,4)_$SELECT($PIECE(D(0),U,13)'="R":" to "_$EXTRACT($$VEN^FBUCUTL(+$PIECE(D(0),U,3)),1,30),1:"")_" for "_$EXTRACT($$VET^FBUCUTL(+$PIECE(D(0),U,4)),1,30)_" - "_$$SSN^FBAAUTL(+$PIECE(D(
- 0),U,4),1)
- +13 SET FBN=FBN+1
- SET XQSTXT(FBN)=" From Date: "_$$DATX^FBAAUTL($PIECE(D(0),U,6))_" To Date: "_$$DATX^FBAAUTL($PIECE(D(0),U,7))_" Invoice Number: "_$PIECE(D(0),U)
- End DoDot:1
- +14 ;
- +15 IF X="T"
- IF $DATA(^FBAAC(D(1),3,D,0))
- SET D(0)=^(0)
- IF $PIECE(D(0),U,7)]""
- SET FBN=FBN+1
- Begin DoDot:1
- +16 SET XQSTXT(FBN)="Check Number: "_$PIECE(D(0),U,7)_" to "_$EXTRACT($$VET^FBUCUTL(+D(1)),1,30)_" - "_$$SSN^FBAAUTL(+D(1),1)_" for travel on"
- +17 SET FBN=FBN+1
- SET XQSTXT(FBN)=" Date: "_$$DATX^FBAAUTL($PIECE(D(0),U))
- End DoDot:1
- +18 QUIT
