- FBAABT ;AISC/CMR - OUTPUT FOR BATCHES ;3/28/2012
- ;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- S FBSTAT=0,DIR(0)="YA",DIR("A")="Do you want to print ALL Fee Basis Batch Status': ",DIR("B")="No" D ^DIR K DIR Q:$D(DIRUT) I Y S FBSTAT=1 D
- .F J="C","S","O","T","P","A","R" S FBSTAT(J)=$S(J="C":"CLERK CLOSED",J="S":"SUPERVISOR CLOSED",J="O":"OPEN",J="T":"TRANSMITTED",J="P":"FORWARDED TO PRICER",J="A":"ASSIGNED PRICE",J="R":"REVIEWED AFTER PRICER")
- .S FBSTAT("F")="CENTRAL FEE ACCEPTED"
- SEL I 'FBSTAT D D ^DIR K DIR G END:$D(DIRUT) S FBSTAT(Y)=Y(0)
- . S DIR(0)="S^O:OPEN;C:CLERK CLOSED;S:SUPERVISOR CLOSED;P:FORWARDED TO PRICER;A:ASSIGNED PRICE;R:REVIEWED AFTER PRICER;T:TRANSMITTED;F:CENTRAL FEE ACCEPTED"
- . S DIR("A")="Select STATUS to print"
- I 'FBSTAT S DIR(0)="YA",DIR("A")="Do you want to select another STATUS: ",DIR("B")="No" D ^DIR K DIR G END:$D(DIRUT),SEL:Y
- S (J,VAR,VAL)="" F S J=$O(FBSTAT(J)) Q:J="" S VAR="FBSTAT(",VAL=VAR
- S PGM="START^FBAABT" D ZIS^FBAAUTL G END:FBPOP
- ;
- START K ^TMP($J,"FBBATO") S (FBST,FBCHK)="",(FBIEN,FBAAOUT)=0,Q="-",$P(Q,"-",17)="-",QQ="=",$P(QQ,"=",80)="=" U IO W:$E(IOST,1,2)["C-" @IOF D HED
- F S FBST=$O(FBSTAT(FBST)) Q:FBST="" F S FBIEN=$O(^FBAA(161.7,"AC",FBST,FBIEN)) Q:FBIEN'>0 D
- .Q:'$D(^FBAA(161.7,FBIEN,0)) S FB(0)=^FBAA(161.7,FBIEN,0),FBBAT=+FB(0),FBDT=+$P(FB(0),"^",4),FBCLK=+$P(FB(0),"^",5),FBTYPE=$P(FB(0),"^",3) S ^TMP($J,"FBBATO",FBST,FBIEN)=FBBAT_"^"_FBDT_"^"_FBCLK_"^"_FBTYPE
- S FBST="",FBIEN=0
- F S FBST=$O(^TMP($J,"FBBATO",FBST)) Q:FBST=""!(FBAAOUT) F S FBIEN=$O(^TMP($J,"FBBATO",FBST,FBIEN)) Q:FBIEN'>0!(FBAAOUT) D
- .S FB(0)=^TMP($J,"FBBATO",FBST,FBIEN),FBBAT=+FB(0),FBDT=$P(FB(0),"^",2),FBCLK=+$P(FB(0),"^",3),FBTYPE=$P(FB(0),"^",4) D PRINT
- END K FBAAOUT,FBSTAT,FBST,FBIEN,FBBAT,FBDT,FBCLK,FB(0),FBCHK,FBTYPE,J,Q,QQ,^TMP($J,"FBBATO") D CLOSE^FBAAUTL
- Q
- PRINT I $Y+5>IOSL,($E(IOST,1,2)["C-") S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
- I $Y+5>IOSL W @IOF D HED
- I FBST'=FBCHK D HED1 S FBCHK=FBST
- W !?2,FBBAT,?9,$S(FBTYPE="B3":"MEDICAL & STAT PAYMENTS",FBTYPE="B5":"HOMETOWN PHARMACY PAYMENTS",FBTYPE="B2":"TRAVEL PAYMENTS",FBTYPE="B9":"CH/CNH",1:""),?38,$$DATX^FBAAUTL(FBDT),?50,$P(^VA(200,FBCLK,0),"^")
- Q
- HED W !?30,"STATUS OF BATCHES",!?30,Q
- W !!!?1,"BATCH #",?12,"BATCH TYPE",?36,"DATE OPENED",?55,"CLERK",!,QQ
- Q
- HED1 W !!,"STATUS: ",FBSTAT(FBST),!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAABT 2441 printed Mar 13, 2025@20:59:41 Page 2
- FBAABT ;AISC/CMR - OUTPUT FOR BATCHES ;3/28/2012
- +1 ;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 SET FBSTAT=0
- SET DIR(0)="YA"
- SET DIR("A")="Do you want to print ALL Fee Basis Batch Status': "
- SET DIR("B")="No"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- QUIT
- IF Y
- SET FBSTAT=1
- Begin DoDot:1
- +4 FOR J="C","S","O","T","P","A","R"
- SET FBSTAT(J)=$SELECT(J="C":"CLERK CLOSED",J="S":"SUPERVISOR CLOSED",J="O":"OPEN",J="T":"TRANSMITTED",J="P":"FORWARDED TO PRICER",J="A":"ASSIGNED PRICE",J="R":"REVIEWED AFTER PRICER")
- +5 SET FBSTAT("F")="CENTRAL FEE ACCEPTED"
- End DoDot:1
- SEL IF 'FBSTAT
- Begin DoDot:1
- +1 SET DIR(0)="S^O:OPEN;C:CLERK CLOSED;S:SUPERVISOR CLOSED;P:FORWARDED TO PRICER;A:ASSIGNED PRICE;R:REVIEWED AFTER PRICER;T:TRANSMITTED;F:CENTRAL FEE ACCEPTED"
- +2 SET DIR("A")="Select STATUS to print"
- End DoDot:1
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- GOTO END
- SET FBSTAT(Y)=Y(0)
- +3 IF 'FBSTAT
- SET DIR(0)="YA"
- SET DIR("A")="Do you want to select another STATUS: "
- SET DIR("B")="No"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- GOTO END
- if Y
- GOTO SEL
- +4 SET (J,VAR,VAL)=""
- FOR
- SET J=$ORDER(FBSTAT(J))
- if J=""
- QUIT
- SET VAR="FBSTAT("
- SET VAL=VAR
- +5 SET PGM="START^FBAABT"
- DO ZIS^FBAAUTL
- if FBPOP
- GOTO END
- +6 ;
- START KILL ^TMP($JOB,"FBBATO")
- SET (FBST,FBCHK)=""
- SET (FBIEN,FBAAOUT)=0
- SET Q="-"
- SET $PIECE(Q,"-",17)="-"
- SET QQ="="
- SET $PIECE(QQ,"=",80)="="
- USE IO
- if $EXTRACT(IOST,1,2)["C-"
- WRITE @IOF
- DO HED
- +1 FOR
- SET FBST=$ORDER(FBSTAT(FBST))
- if FBST=""
- QUIT
- FOR
- SET FBIEN=$ORDER(^FBAA(161.7,"AC",FBST,FBIEN))
- if FBIEN'>0
- QUIT
- Begin DoDot:1
- +2 if '$DATA(^FBAA(161.7,FBIEN,0))
- QUIT
- SET FB(0)=^FBAA(161.7,FBIEN,0)
- SET FBBAT=+FB(0)
- SET FBDT=+$PIECE(FB(0),"^",4)
- SET FBCLK=+$PIECE(FB(0),"^",5)
- SET FBTYPE=$PIECE(FB(0),"^",3)
- SET ^TMP($JOB,"FBBATO",FBST,FBIEN)=FBBAT_"^"_FBDT_"^"_FBCLK_"^"_FBTYPE
- End DoDot:1
- +3 SET FBST=""
- SET FBIEN=0
- +4 FOR
- SET FBST=$ORDER(^TMP($JOB,"FBBATO",FBST))
- if FBST=""!(FBAAOUT)
- QUIT
- FOR
- SET FBIEN=$ORDER(^TMP($JOB,"FBBATO",FBST,FBIEN))
- if FBIEN'>0!(FBAAOUT)
- QUIT
- Begin DoDot:1
- +5 SET FB(0)=^TMP($JOB,"FBBATO",FBST,FBIEN)
- SET FBBAT=+FB(0)
- SET FBDT=$PIECE(FB(0),"^",2)
- SET FBCLK=+$PIECE(FB(0),"^",3)
- SET FBTYPE=$PIECE(FB(0),"^",4)
- DO PRINT
- End DoDot:1
- END KILL FBAAOUT,FBSTAT,FBST,FBIEN,FBBAT,FBDT,FBCLK,FB(0),FBCHK,FBTYPE,J,Q,QQ,^TMP($JOB,"FBBATO")
- DO CLOSE^FBAAUTL
- +1 QUIT
- PRINT IF $Y+5>IOSL
- IF ($EXTRACT(IOST,1,2)["C-")
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET FBAAOUT=1
- QUIT
- +1 IF $Y+5>IOSL
- WRITE @IOF
- DO HED
- +2 IF FBST'=FBCHK
- DO HED1
- SET FBCHK=FBST
- +3 WRITE !?2,FBBAT,?9,$SELECT(FBTYPE="B3":"MEDICAL & STAT PAYMENTS",FBTYPE="B5":"HOMETOWN PHARMACY PAYMENTS",FBTYPE="B2":"TRAVEL PAYMENTS",FBTYPE="B9":"CH/CNH",1:""),?38,$$DATX^FBAAUTL(FBDT),?50,$PIECE(^VA(200,FBCLK,0),"^")
- +4 QUIT
- HED WRITE !?30,"STATUS OF BATCHES",!?30,Q
- +1 WRITE !!!?1,"BATCH #",?12,"BATCH TYPE",?36,"DATE OPENED",?55,"CLERK",!,QQ
- +2 QUIT
- HED1 WRITE !!,"STATUS: ",FBSTAT(FBST),!
- +1 QUIT
