- PRCAREPT ;SF-ISC/YJK-AR LIST,REPORT ;8/26/93 8:43 AM
- V ;;4.5;Accounts Receivable;**68,63,108,299**;Mar 20, 1995;Build 6
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;MAS,Agent Cashier, 3rd party,RC/DOJ reports.
- PRINT ;ask if the report will be queued.
- K PRCAQUE S PRCA("MESS")="Do you wish to queue this report "
- QUE S %=2 W !,PRCA("MESS") D YN^DICN Q:%<0 W " "
- I %=0 W !,"Answer <YES> or <NO>" G QUE
- K IO("Q") S %ZIS("B")="",%ZIS="M",PRCA("DEV")="" S:%=1 %ZIS="MQ",PRCA("DEV")="Q;",IOP="Q"
- ;
- DIP S L=0,FLDS=PRCATEMP,BY=PRCASORT,FR=PRCAFT,TO=PRCALAST,DHD=PRCAHDR
- D EN1^DIP K L,FLDS,BY,FR,TO,DHD,DIC,DIS,IOP
- ;
- KILLV K ZTSK,PRCAKDT1,PRCAQUE,DQTIME,PRCAKDT2,PRCACT,PRCARCOJ,PRCATEMP,PRCADT1,PRCADT2,PRCABN,PRCABILN,PRCAHDR,PRCAFT,PRCALAST,PRCATEMP,PRCASORT,PRCADMC,PRCANAME,DTOUT,DUOUT,DIR,DIRUT Q
- END D KILLV K PRCA,PRCAIOP Q
- ;
- REPT ;====================== REPORT SUBROUTINES ==========================
- EN2 ;report for MAS reconciliation with AR for 3rd Party.
- S PRCA("DATE")="DATE BILL PREPARED" D ASKDT^PRCAQUE G:(PRCADT1="")!(PRCADT2="") END
- S PRCAFT=PRCADT1_",T,100",PRCALAST=PRCADT2_",T,199",PRCAHDR="MAS RECONCILIATION REPORT"
- S DIC="^PRCA(430," S PRCATEMP="[PRCAR MAS REPORT]",PRCASORT="@DATE BILL PREPARED,@CATEGORY:INTERNAL(TYPE),@CURRENT STATUS:STATUS NUMBER" D PRINT,END Q
- ;
- EN3 ;print 3rd party accounts receivable report.
- S PRCAHDR="3RD PARTY ACTIVE REFERRAL REPORT"
- S PRCASORT="DEBTOR;S2,PATIENT,RC/DOJ REFERRAL DATE,@CURRENT STATUS:STATUS NUMBER,@CATEGORY:INTERNAL(TYPE)"
- S PRCAFT=",,,102,T",PRCALAST=",,,102,T"
- S PRCATEMP="[PRCA 3RD REPORT]",DIC="^PRCA(430," D PRINT,END Q
- ;
- EN4 ;Report AR referred to RC
- S PRCA("DATE")="DATE REFERRED TO RC" D ASKDT^PRCAQUE G:(PRCADT1="")!(PRCADT2="") END
- S PRCACT=0,PRCARCOJ="",PRCATEMP="[PRCAD DC DOJ]"
- S PRCASORT="DEBTOR;S1,@RC/DOJ REFERRAL DATE,@RC/DOJ REFERRAL CODE"
- S PRCAFT=","_PRCADT1_",RC",PRCALAST=","_PRCADT2_",RC"
- S PRCAHDR="ACCOUNTS RECEIVABLE REFERRED TO RC"
- K PRCAEN4 S DIC="^PRCA(430," D PRINT,END Q
- ;
- EN5 ;Report AR referred to DOJ
- S PRCA("DATE")="DATE REFERRED TO DOJ" D ASKDT^PRCAQUE G:(PRCADT1="")!(PRCADT2="") END
- S PRCATEMP="[PRCAD DC DOJ]",PRCASORT="DEBTOR;S1,@RC/DOJ REFERRAL DATE,@RC/DOJ REFERRAL CODE"
- S PRCAFT=","_PRCADT1_",DOJ",PRCALAST=","_PRCADT2_",DOJ"
- S PRCAHDR="ACCOUNTS RECEIVABLE REFERRED TO DOJ",DIC="^PRCA(430," D PRINT,END Q
- ;
- EN6 ;print other transaction for CALM code sheet in the AT section.
- D TSK^PRCAPTR Q
- ;
- EN8 ;RC debt collection report.
- S PRCA("DATE")="DATE RC TRANSACTION CREATED" D ASKDT^PRCAQUE G:(PRCADT1="")!(PRCADT2="") END
- S PRCATEMP="[PRCAS DC]",PRCASORT="+TRANSACTION TYPE;S2,@DATE ENTERED"
- S PRCAHDR="REGIONAL COUNSEL DEBT COLLECTION REPORT FROM "_PRCAKDT1_" TO "_PRCAKDT2
- S DIC="^PRCA(433,",PRCAFT=","_PRCADT1,PRCALAST=","_PRCADT2
- S DIS(1)="I $P($G(^PRCA(433,D0,0)),U,7)=""RC"""
- S DIS(2)="I $P($G(^PRCA(433,D0,0)),U,7)=""DC"""
- S DIS(0)="I $P($G(^PRCA(433,D0,1)),U,2)'=45"
- D PRINT,END Q
- ;
- EN9 ;DOJ debt collection report.
- S PRCA("DATE")="DATE DOJ TRANSACTION CREATED" D ASKDT^PRCAQUE G:(PRCADT1="")!(PRCADT2="") END
- S PRCATEMP="[PRCAS DC]",PRCASORT="+TRANSACTION TYPE;S2,@RC DOJ CODE,@DATE ENTERED"
- S PRCAHDR="DEPARTMENT OF JUSTICE DEBT COLLECTION REPORT FROM "_PRCAKDT1_" TO "_PRCAKDT2
- S DIC="^PRCA(433,",PRCAFT=",DOJ,"_PRCADT1,PRCALAST=",DOJ,"_PRCADT2
- S DIS(0)="I $P($G(^PRCA(433,D0,1)),U,2)'=45"
- D PRINT,END Q
- ;
- EN10 ;print contingent (Worker's Comp & Tort Feasors) 3rd party accounts receivable report.
- S PRCA("DATE")="DATE REFERRED TO RC/DOJ" D ASKDT^PRCAQUE G:(PRCADT1="")!(PRCADT2="") END
- S PRCAHDR="REFERRED TP TORT & WORKER'S COMP AR REPORT"
- S PRCASORT="DEBTOR;S1,@REFERRAL DATE,@CURRENT STATUS:STATUS NUMBER,@CATEGORY:CATEGORY NUMBER"
- S PRCAFT=","_PRCADT1_",102,22",PRCALAST=","_PRCADT2_",102,23"
- S PRCATEMP="[PRCAR CONTINGENT REPORT]",DIC="^PRCA(430," D PRINT,END Q
- ;
- EN11 ;print DMC referred debts
- W !!,"This report should be run on or AFTER the first Wednesday of the month."
- W !,"Make sure your facility has received the monthly offset information from"
- W !,"the DMC to insure the accuracy of this report."
- ;
- W !!,?5,"Enter DMC Report to print:"
- W !,?10,"1 - All Patients"
- W !,?10,"2 - Single Patient",!
- ;
- S DIR(0)="LO^1:2:0"
- S DIR("A")="Report",DIR("B")="1",DIR("?",1)="Enter '1' to print DMC information for ALL patients.",DIR("?")="Enter '2' to print DMC information about a single patient."
- D ^DIR G:$D(DIRUT) END
- S PRCADMC=+Y
- ;
- I PRCADMC=2 S DIC="^RCD(340,",DIC(0)="AEQZ" D ^DIC I Y<0 K PRCADMC,DIC G END
- S PRCANAME=+Y
- I $D(DTOUT)!$D(DUOUT) G END
- S PRCAHDR="REFERRED DMC DEBTS"
- ;S PRCASORT="@DATE SENT TO DMC,+@INTERNAL(DEBTOR);S2"
- I PRCADMC=1 S PRCAFT=",",PRCALAST=",",PRCASORT="@DATE SENT TO DMC,+DEBTOR;S2"
- I PRCADMC=2 S PRCAFT=","_PRCANAME,PRCALAST=","_PRCANAME,PRCASORT="@DATE SENT TO DMC,+@INTERNAL(DEBTOR)"
- S PRCATEMP="[RCDMC REFERRED DEBTS]",DIC="^PRCA(430," D PRINT,END Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAREPT 4999 printed Jan 18, 2025@02:42:20 Page 2
- PRCAREPT ;SF-ISC/YJK-AR LIST,REPORT ;8/26/93 8:43 AM
- V ;;4.5;Accounts Receivable;**68,63,108,299**;Mar 20, 1995;Build 6
- +1 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +2 ;MAS,Agent Cashier, 3rd party,RC/DOJ reports.
- PRINT ;ask if the report will be queued.
- +1 KILL PRCAQUE
- SET PRCA("MESS")="Do you wish to queue this report "
- QUE SET %=2
- WRITE !,PRCA("MESS")
- DO YN^DICN
- if %<0
- QUIT
- WRITE " "
- +1 IF %=0
- WRITE !,"Answer <YES> or <NO>"
- GOTO QUE
- +2 KILL IO("Q")
- SET %ZIS("B")=""
- SET %ZIS="M"
- SET PRCA("DEV")=""
- if %=1
- SET %ZIS="MQ"
- SET PRCA("DEV")="Q;"
- SET IOP="Q"
- +3 ;
- DIP SET L=0
- SET FLDS=PRCATEMP
- SET BY=PRCASORT
- SET FR=PRCAFT
- SET TO=PRCALAST
- SET DHD=PRCAHDR
- +1 DO EN1^DIP
- KILL L,FLDS,BY,FR,TO,DHD,DIC,DIS,IOP
- +2 ;
- KILLV KILL ZTSK,PRCAKDT1,PRCAQUE,DQTIME,PRCAKDT2,PRCACT,PRCARCOJ,PRCATEMP,PRCADT1,PRCADT2,PRCABN,PRCABILN,PRCAHDR,PRCAFT,PRCALAST,PRCATEMP,PRCASORT,PRCADMC,PRCANAME,DTOUT,DUOUT,DIR,DIRUT
- QUIT
- END DO KILLV
- KILL PRCA,PRCAIOP
- QUIT
- +1 ;
- REPT ;====================== REPORT SUBROUTINES ==========================
- EN2 ;report for MAS reconciliation with AR for 3rd Party.
- +1 SET PRCA("DATE")="DATE BILL PREPARED"
- DO ASKDT^PRCAQUE
- if (PRCADT1="")!(PRCADT2="")
- GOTO END
- +2 SET PRCAFT=PRCADT1_",T,100"
- SET PRCALAST=PRCADT2_",T,199"
- SET PRCAHDR="MAS RECONCILIATION REPORT"
- +3 SET DIC="^PRCA(430,"
- SET PRCATEMP="[PRCAR MAS REPORT]"
- SET PRCASORT="@DATE BILL PREPARED,@CATEGORY:INTERNAL(TYPE),@CURRENT STATUS:STATUS NUMBER"
- DO PRINT
- DO END
- QUIT
- +4 ;
- EN3 ;print 3rd party accounts receivable report.
- +1 SET PRCAHDR="3RD PARTY ACTIVE REFERRAL REPORT"
- +2 SET PRCASORT="DEBTOR;S2,PATIENT,RC/DOJ REFERRAL DATE,@CURRENT STATUS:STATUS NUMBER,@CATEGORY:INTERNAL(TYPE)"
- +3 SET PRCAFT=",,,102,T"
- SET PRCALAST=",,,102,T"
- +4 SET PRCATEMP="[PRCA 3RD REPORT]"
- SET DIC="^PRCA(430,"
- DO PRINT
- DO END
- QUIT
- +5 ;
- EN4 ;Report AR referred to RC
- +1 SET PRCA("DATE")="DATE REFERRED TO RC"
- DO ASKDT^PRCAQUE
- if (PRCADT1="")!(PRCADT2="")
- GOTO END
- +2 SET PRCACT=0
- SET PRCARCOJ=""
- SET PRCATEMP="[PRCAD DC DOJ]"
- +3 SET PRCASORT="DEBTOR;S1,@RC/DOJ REFERRAL DATE,@RC/DOJ REFERRAL CODE"
- +4 SET PRCAFT=","_PRCADT1_",RC"
- SET PRCALAST=","_PRCADT2_",RC"
- +5 SET PRCAHDR="ACCOUNTS RECEIVABLE REFERRED TO RC"
- +6 KILL PRCAEN4
- SET DIC="^PRCA(430,"
- DO PRINT
- DO END
- QUIT
- +7 ;
- EN5 ;Report AR referred to DOJ
- +1 SET PRCA("DATE")="DATE REFERRED TO DOJ"
- DO ASKDT^PRCAQUE
- if (PRCADT1="")!(PRCADT2="")
- GOTO END
- +2 SET PRCATEMP="[PRCAD DC DOJ]"
- SET PRCASORT="DEBTOR;S1,@RC/DOJ REFERRAL DATE,@RC/DOJ REFERRAL CODE"
- +3 SET PRCAFT=","_PRCADT1_",DOJ"
- SET PRCALAST=","_PRCADT2_",DOJ"
- +4 SET PRCAHDR="ACCOUNTS RECEIVABLE REFERRED TO DOJ"
- SET DIC="^PRCA(430,"
- DO PRINT
- DO END
- QUIT
- +5 ;
- EN6 ;print other transaction for CALM code sheet in the AT section.
- +1 DO TSK^PRCAPTR
- QUIT
- +2 ;
- EN8 ;RC debt collection report.
- +1 SET PRCA("DATE")="DATE RC TRANSACTION CREATED"
- DO ASKDT^PRCAQUE
- if (PRCADT1="")!(PRCADT2="")
- GOTO END
- +2 SET PRCATEMP="[PRCAS DC]"
- SET PRCASORT="+TRANSACTION TYPE;S2,@DATE ENTERED"
- +3 SET PRCAHDR="REGIONAL COUNSEL DEBT COLLECTION REPORT FROM "_PRCAKDT1_" TO "_PRCAKDT2
- +4 SET DIC="^PRCA(433,"
- SET PRCAFT=","_PRCADT1
- SET PRCALAST=","_PRCADT2
- +5 SET DIS(1)="I $P($G(^PRCA(433,D0,0)),U,7)=""RC"""
- +6 SET DIS(2)="I $P($G(^PRCA(433,D0,0)),U,7)=""DC"""
- +7 SET DIS(0)="I $P($G(^PRCA(433,D0,1)),U,2)'=45"
- +8 DO PRINT
- DO END
- QUIT
- +9 ;
- EN9 ;DOJ debt collection report.
- +1 SET PRCA("DATE")="DATE DOJ TRANSACTION CREATED"
- DO ASKDT^PRCAQUE
- if (PRCADT1="")!(PRCADT2="")
- GOTO END
- +2 SET PRCATEMP="[PRCAS DC]"
- SET PRCASORT="+TRANSACTION TYPE;S2,@RC DOJ CODE,@DATE ENTERED"
- +3 SET PRCAHDR="DEPARTMENT OF JUSTICE DEBT COLLECTION REPORT FROM "_PRCAKDT1_" TO "_PRCAKDT2
- +4 SET DIC="^PRCA(433,"
- SET PRCAFT=",DOJ,"_PRCADT1
- SET PRCALAST=",DOJ,"_PRCADT2
- +5 SET DIS(0)="I $P($G(^PRCA(433,D0,1)),U,2)'=45"
- +6 DO PRINT
- DO END
- QUIT
- +7 ;
- EN10 ;print contingent (Worker's Comp & Tort Feasors) 3rd party accounts receivable report.
- +1 SET PRCA("DATE")="DATE REFERRED TO RC/DOJ"
- DO ASKDT^PRCAQUE
- if (PRCADT1="")!(PRCADT2="")
- GOTO END
- +2 SET PRCAHDR="REFERRED TP TORT & WORKER'S COMP AR REPORT"
- +3 SET PRCASORT="DEBTOR;S1,@REFERRAL DATE,@CURRENT STATUS:STATUS NUMBER,@CATEGORY:CATEGORY NUMBER"
- +4 SET PRCAFT=","_PRCADT1_",102,22"
- SET PRCALAST=","_PRCADT2_",102,23"
- +5 SET PRCATEMP="[PRCAR CONTINGENT REPORT]"
- SET DIC="^PRCA(430,"
- DO PRINT
- DO END
- QUIT
- +6 ;
- EN11 ;print DMC referred debts
- +1 WRITE !!,"This report should be run on or AFTER the first Wednesday of the month."
- +2 WRITE !,"Make sure your facility has received the monthly offset information from"
- +3 WRITE !,"the DMC to insure the accuracy of this report."
- +4 ;
- +5 WRITE !!,?5,"Enter DMC Report to print:"
- +6 WRITE !,?10,"1 - All Patients"
- +7 WRITE !,?10,"2 - Single Patient",!
- +8 ;
- +9 SET DIR(0)="LO^1:2:0"
- +10 SET DIR("A")="Report"
- SET DIR("B")="1"
- SET DIR("?",1)="Enter '1' to print DMC information for ALL patients."
- SET DIR("?")="Enter '2' to print DMC information about a single patient."
- +11 DO ^DIR
- if $DATA(DIRUT)
- GOTO END
- +12 SET PRCADMC=+Y
- +13 ;
- +14 IF PRCADMC=2
- SET DIC="^RCD(340,"
- SET DIC(0)="AEQZ"
- DO ^DIC
- IF Y<0
- KILL PRCADMC,DIC
- GOTO END
- +15 SET PRCANAME=+Y
- +16 IF $DATA(DTOUT)!$DATA(DUOUT)
- GOTO END
- +17 SET PRCAHDR="REFERRED DMC DEBTS"
- +18 ;S PRCASORT="@DATE SENT TO DMC,+@INTERNAL(DEBTOR);S2"
- +19 IF PRCADMC=1
- SET PRCAFT=","
- SET PRCALAST=","
- SET PRCASORT="@DATE SENT TO DMC,+DEBTOR;S2"
- +20 IF PRCADMC=2
- SET PRCAFT=","_PRCANAME
- SET PRCALAST=","_PRCANAME
- SET PRCASORT="@DATE SENT TO DMC,+@INTERNAL(DEBTOR)"
- +21 SET PRCATEMP="[RCDMC REFERRED DEBTS]"
- SET DIC="^PRCA(430,"
- DO PRINT
- DO END
- QUIT
- +22 ;