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 Apr 09, 2024@20:48:54 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 ;
