- FBNHPLT ;AISC/GRR-PRINT CNH PAYMENTS AND TOTALS FOR A MONTH ;1DEC00
- ;;3.5;FEE BASIS;**25**;JAN 30, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ASK S %DT(0)=-DT,%DT="AEPMX",%DT("A")="Community Nursing Home Payment List for which Month/Year: " D ^%DT K %DT G END:X="^"!(X=""),ASK:Y<0
- S FBPAYDT=$E(+Y,1,5)_"00",VAR="FBPAYDT",VAL=FBPAYDT,PGM="START^FBNHPLT" D ZIS^FBAAUTL G:FBPOP END W !
- START K ^TMP($J) S Q="",$P(Q,"=",80)="=",(FBGTOT,FBVTOT)=0,FBENDDT=$E(FBPAYDT,1,5)_31 U IO W:$E(IOST,1,2)["C-" @IOF D HED
- BEG F FBJ=FBPAYDT:0 S FBJ=$O(^FBAAI("AD",FBJ)) Q:FBJ'>0!(FBJ>FBENDDT) F IFN=0:0 S IFN=$O(^FBAAI("AD",FBJ,IFN)) Q:IFN'>0 I $D(^FBAAI(IFN,0)) S FBZ=^(0) D SETUP
- S FBSW=1 F FBVEN=0:0 S FBVEN=$O(^TMP($J,FBVEN)) Q:FBVEN'>0 D:'FBSW TOT S FBSW=0 D GETVEN F DFN=0:0 S DFN=$O(^TMP($J,FBVEN,DFN)) Q:DFN'>0 S IFN=$O(^TMP($J,FBVEN,DFN,0)) Q:IFN'>0 I $D(^FBAAI(IFN,0)) S FBZ=^(0) D MORE
- S FBGTOT=FBGTOT+FBVTOT D TOT W !!,"Grand Total Dollars: ",$J(FBGTOT,7,2)
- END K FBGTOT,FBVTOT,FBJ,DFN,FBVEN,FBZ,IFN,VAR,VAL,PGM,FBSW,FBAP,FBENDDT,FBNAME,FBPAYDT,FBVID,FBVNAME,Q,SSN,X,X1,Y
- D CLOSE^FBAAUTL Q
- GETVEN S FBGTOT=FBGTOT+FBVTOT,FBVTOT=0,FBVNAME=$S($D(^FBAAV(FBVEN,0)):$P(^(0),"^",1),1:""),FBVID=$S(FBVNAME'="":$P(^(0),"^",2),1:"")
- PVHED I $Y+3>IOSL W @IOF D HED
- W !!,FBVNAME,?50,FBVID
- Q
- HED W "Community Nursing Home Payment List & Totals for: ",$P("January^February^March^April^May^June^July^August^September^October^November^December","^",+$E(FBPAYDT,4,5))," ",(1700+$E(FBPAYDT,1,3)),!
- D NOW^%DTC S Y=% X ^DD("DD") W ?10,"Processed: ",Y,!
- W "Vendor Name",?50,"Vendor ID",!,?8,"Veteran Name",?39," SSN",?51,"Amount Paid",!,Q
- Q
- MORE S FBNAME=$$NAME^FBCHREQ2(DFN),SSN=$$SSN^FBAAUTL(DFN),FBAP=$P(FBZ,"^",9),FBVTOT=FBVTOT+FBAP
- I $Y+3>IOSL D PVHED
- W !,?8,FBNAME,?39,SSN,?51,$J(FBAP,7,2)
- Q
- TOT W !,?51,"-------",!,?35,"Vendor Total:",?51,$J(FBVTOT,7,2) Q
- SETUP I $P(FBZ,"^",14)="",$P(FBZ,"^",12)=7,'$D(^FBAAI(IFN,"FBREJ")) S ^TMP($J,$P(FBZ,"^",3),$P(FBZ,"^",4),IFN)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBNHPLT 2030 printed Feb 18, 2025@23:25:34 Page 2
- FBNHPLT ;AISC/GRR-PRINT CNH PAYMENTS AND TOTALS FOR A MONTH ;1DEC00
- +1 ;;3.5;FEE BASIS;**25**;JAN 30, 1995
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ASK SET %DT(0)=-DT
- SET %DT="AEPMX"
- SET %DT("A")="Community Nursing Home Payment List for which Month/Year: "
- DO ^%DT
- KILL %DT
- if X="^"!(X="")
- GOTO END
- if Y<0
- GOTO ASK
- +1 SET FBPAYDT=$EXTRACT(+Y,1,5)_"00"
- SET VAR="FBPAYDT"
- SET VAL=FBPAYDT
- SET PGM="START^FBNHPLT"
- DO ZIS^FBAAUTL
- if FBPOP
- GOTO END
- WRITE !
- START KILL ^TMP($JOB)
- SET Q=""
- SET $PIECE(Q,"=",80)="="
- SET (FBGTOT,FBVTOT)=0
- SET FBENDDT=$EXTRACT(FBPAYDT,1,5)_31
- USE IO
- if $EXTRACT(IOST,1,2)["C-"
- WRITE @IOF
- DO HED
- BEG FOR FBJ=FBPAYDT:0
- SET FBJ=$ORDER(^FBAAI("AD",FBJ))
- if FBJ'>0!(FBJ>FBENDDT)
- QUIT
- FOR IFN=0:0
- SET IFN=$ORDER(^FBAAI("AD",FBJ,IFN))
- if IFN'>0
- QUIT
- IF $DATA(^FBAAI(IFN,0))
- SET FBZ=^(0)
- DO SETUP
- +1 SET FBSW=1
- FOR FBVEN=0:0
- SET FBVEN=$ORDER(^TMP($JOB,FBVEN))
- if FBVEN'>0
- QUIT
- if 'FBSW
- DO TOT
- SET FBSW=0
- DO GETVEN
- FOR DFN=0:0
- SET DFN=$ORDER(^TMP($JOB,FBVEN,DFN))
- if DFN'>0
- QUIT
- SET IFN=$ORDER(^TMP($JOB,FBVEN,DFN,0))
- if IFN'>0
- QUIT
- IF $DATA(^FBAAI(IFN,0))
- SET FBZ=^(0)
- DO MORE
- +2 SET FBGTOT=FBGTOT+FBVTOT
- DO TOT
- WRITE !!,"Grand Total Dollars: ",$JUSTIFY(FBGTOT,7,2)
- END KILL FBGTOT,FBVTOT,FBJ,DFN,FBVEN,FBZ,IFN,VAR,VAL,PGM,FBSW,FBAP,FBENDDT,FBNAME,FBPAYDT,FBVID,FBVNAME,Q,SSN,X,X1,Y
- +1 DO CLOSE^FBAAUTL
- QUIT
- GETVEN SET FBGTOT=FBGTOT+FBVTOT
- SET FBVTOT=0
- SET FBVNAME=$SELECT($DATA(^FBAAV(FBVEN,0)):$PIECE(^(0),"^",1),1:"")
- SET FBVID=$SELECT(FBVNAME'="":$PIECE(^(0),"^",2),1:"")
- PVHED IF $Y+3>IOSL
- WRITE @IOF
- DO HED
- +1 WRITE !!,FBVNAME,?50,FBVID
- +2 QUIT
- HED WRITE "Community Nursing Home Payment List & Totals for: ",$PIECE("January^February^March^April^May^June^July^August^September^October^November^December","^",+$EXTRACT(FBPAYDT,4,5))," ",(1700+$EXTRACT(FBPAYDT,1,3)),!
- +1 DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- WRITE ?10,"Processed: ",Y,!
- +2 WRITE "Vendor Name",?50,"Vendor ID",!,?8,"Veteran Name",?39," SSN",?51,"Amount Paid",!,Q
- +3 QUIT
- MORE SET FBNAME=$$NAME^FBCHREQ2(DFN)
- SET SSN=$$SSN^FBAAUTL(DFN)
- SET FBAP=$PIECE(FBZ,"^",9)
- SET FBVTOT=FBVTOT+FBAP
- +1 IF $Y+3>IOSL
- DO PVHED
- +2 WRITE !,?8,FBNAME,?39,SSN,?51,$JUSTIFY(FBAP,7,2)
- +3 QUIT
- TOT WRITE !,?51,"-------",!,?35,"Vendor Total:",?51,$JUSTIFY(FBVTOT,7,2)
- QUIT
- SETUP IF $PIECE(FBZ,"^",14)=""
- IF $PIECE(FBZ,"^",12)=7
- IF '$DATA(^FBAAI(IFN,"FBREJ"))
- SET ^TMP($JOB,$PIECE(FBZ,"^",3),$PIECE(FBZ,"^",4),IFN)=""
- +1 QUIT
