source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAG.m@ 1801

Last change on this file since 1801 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1PRCAG ;WASH-ISC@ALTOONA,PA/CMS-Reprint Statement/Letter Option Entries ;8/23/93 2:42 PM
2V ;;4.5;Accounts Receivable;**149,165,198**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4REP ;ENTRY FROM REPRINT PAT STATEMENT
5 NEW BEG,END,DAT,DATE,DEB,DIC,HDAT,IOP,SITE,TYP,X,Y,ZTDESC,ZTRTN,ZTSAVE,%DT
6 W !!
7ADT S %DT="AEXP",%DT(0)="-NOW",%DT("A")="Enter a Date to Reprint: " D ^%DT I Y<1 G REPQ
8 S Y=$P(Y,".")
9 I $P($O(^RC(341,"C",Y)),".")'=Y W !!,*7,"No notifications sent on that date",! G ADT
10 S DAT=9999999-Y
11 W !!,"Press return at the 'Patient:' prompts to reprint all patient statements",!,"for the date selected or select a start and/or end point."
12 W !,"NOTE: The range is in print order not alphabetic!",!
13 N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
14 S DIC="^RCD(340,",DIC(0)="AEMNQ",DIC("A")="Start from Patient: ",DIC("S")="I $P(^(0),U,1)[""DPT""" D ^DIC I ($D(DTOUT))!(X["^") G REPQ
15 S BEG=0,Y=+Y
16 I Y>0 S BEG=-1,DEB=+Y,TYP=+$O(^RC(341.1,"AC",2,0)) F DATE=DAT-.0001:0 S DATE=$O(^RC(341,"AD",DEB,TYP,DATE)) Q:$P(DATE,".")'=DAT S BEG=$O(^RC(341,"AD",DEB,TYP,DATE,0)) Q
17 I BEG=0 S BEG=$O(^RC(341,"C",+$O(^RC(341,"C",9999999-DAT)),0)) S:'BEG BEG=-1
18 I BEG<0 W *7,!," Sorry, Debtor Statement not found on this date!" G ADT
19 S DIC="^RCD(340,",DIC(0)="AEMNQ",DIC("A")="End after Patient: ",DIC("S")="I $P(^(0),U,1)[""DPT""" D ^DIC I ($D(DTOUT))!(X["^") G REPQ
20 S END="*",Y=+Y
21 I Y>0 S END=-1,DEB=+Y,TYP=+$O(^RC(341.1,"AC",2,0)) F DATE=DAT-.0001:0 S DATE=$O(^RC(341,"AD",DEB,TYP,DATE)) Q:$P(DATE,".")'=DAT S END=$O(^RC(341,"AD",DEB,TYP,DATE,0)) Q
22 I END<0 W *7,!," Sorry, Debtor Statement not found on this date!" G ADT
23 I END'="*",END<BEG W *7,!,"Ending bill is before starting bill!" G ADT
24 S HDAT=9999999-DAT
25REPD W !! S %ZIS="QN",IOP="Q",%ZIS("B")=$P($G(^RC(342,1,0)),U,8) D ^%ZIS G:POP REPQ
26 I '$D(IO("Q")) W !!,*7,"YOU MUST QUEUE THIS OUTPUT",! G REPD
27 S ZTRTN="REP^PRCAGS",ZTDESC="Reprint AR Patient Statements",ZTSAVE("BEG")="",ZTSAVE("END")="",ZTSAVE("HDAT")="" D ^%ZTLOAD
28REPQ D ^%ZISC Q
29UB ;ENTRY FROM REPRINT UB BILLS
30 S ETY="UB" ;set event type to UB and use REB sub-routine
31REB ;ENTRY FROM REPRINT FOLLOW-UP LETTERS
32 NEW BEG,END,DAT,DATE,DEB,DIC,IOP,SITE,TYP,X,Y,ZTDESC,ZTRTN,ZTSAVE,%DT
33 D SITE^PRCAGU
34 S:'$D(ETY) ETY="FL"
35REBDT S %DT="AEXP",%DT(0)="-NOW",%DT("A")="Enter a Date to Reprint: " D ^%DT G:Y<1 REBQ
36 S Y=$P(Y,".")
37 I $P($O(^RC(341,"C",Y)),".")'=Y W !!,*7,"No notifications sent on that date",! G REBDT
38 S DAT=9999999-Y
39 W !!,"Press return at the 'Bill:' prompts to reprint all ",ETY," Letters",!,"for the date selected or select a start and/or end point."
40 W !,"Do not select bills that print on the Patient Statement."
41 W !,"NOTE: The range is in print order not alphabetic!",!
42 N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
43 S DIC="^PRCA(430,",DIC(0)="AEMNQ",DIC("A")="Start from Bill: ",DIC("S")="I "",18,25,5,24,1,2,3,4,23,22,""'[("",""_$P(^(0),U,2)_"","")" D ^DIC I ($D(DTOUT))!(X["^") G REBQ
44 S BEG=0,Y=+Y
45 I Y>0 S BEG=-1,DEB=+$P($G(^PRCA(430,Y,0)),U,9),TYP=+$O(^RC(341.1,"AC",$S(ETY="UB":9,1:10),0)) F DATE=DAT-.0001:0 S DATE=$O(^RC(341,"AD",DEB,TYP,DATE)) Q:$P(DATE,".")'=DAT D
46 .F DA=0:0 S DA=$O(^RC(341,"AD",DEB,TYP,DATE,DA)) Q:'DA I +$G(^RC(341,DA,5))=Y S BEG=DA,DEB=0 Q
47 .Q
48 I BEG=0 S BEG=$O(^RC(341,"C",+$O(^RC(341,"C",9999999-DAT)),0)) S:'BEG BEG=-1
49 I BEG<0 W *7,!," Sorry, not found!" G REBDT
50 S DIC("A")="End after Bill: " D ^DIC I ($D(DTOUT))!(X["^") G REBQ
51 S END="*",Y=+Y
52 I Y>0 S END=-1,DEB=+$P($G(^PRCA(430,Y,0)),U,9),TYP=+$O(^RC(341.1,"AC",$S(ETY="UB":9,1:10),0)) F DATE=DAT-.0001:0 S DATE=$O(^RC(341,"AD",DEB,TYP,DATE)) Q:$P(DATE,".")'=DAT D
53 .F DA=0:0 S DA=$O(^RC(341,"AD",DEB,TYP,DATE,DA)) Q:'DA I +$G(^RC(341,DA,5))=Y S END=DA,DEB=0 Q
54 .Q
55 I END<0 W *7,!," Sorry, not found!" G REBDT
56 I END'="*",END<BEG W *7,!,"Ending bill is before starting bill!" G REBDT
57 W !!
58REBD I ETY="UB" S ZTIO="" G REBD1
59 S %ZIS("B")=$P($G(^RC(342,1,0)),U,8),%ZIS="QN",IOP="Q" D ^%ZIS G:POP REBQ
60 I '$D(IO("Q")) W !!,*7,"YOU MUST QUEUE THIS OUTPUT",! G REBD
61REBD1 S ZTRTN="BILL^PRCAGS",ZTSAVE("BEG")="",ZTSAVE("END")="",ZTSAVE("DAT")="",ZTSAVE("SITE")="",ZTSAVE("ETY")=""
62 S ZTDESC=$S(ETY="UB":"AR Reprint UB Letters",1:"Reprint AR Follow-up Letters") D ^%ZTLOAD
63REBQ K ETY D ^%ZISC Q
64PRDT ;ENTRY FROM PRINT STATEMENT/LETTER BY DATE OPTION
65 D PRDT^PRCAGP
66 Q
Note: See TracBrowser for help on using the repository browser.