Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCACM.m

    r613 r623  
    1 PRCACM  ;WASH-ISC@ALTOONA,PA/RGY-COMMENT ADJUSTMENT TRANSACTION ;6/2/95  2:41 PM
    2         ;;4.5;Accounts Receivable;**8,67,125,169,254**;Mar 20, 1995;Build 2
    3         ;;Per VHA Directive 2004-038, this routine should not be modified.
    4         ; DBIA 3820-A used for direct global read into file 399.
    5         ;
    6         ;This is a routine for adjustment transaction.
    7         NEW PRCABN,PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,DIROUT,DIRUT,DIR,DUOUT,PRCA,PRCATY
    8 ADJUST  D BEGIN G:('$D(PRCABN))!('$D(PRCAEN)) Q
    9         S PRCAA1=$S($D(^PRCA(433,PRCAEN,4,0)):+$P(^(0),U,4),1:0) G Q:PRCAA1'>0 S PRCAA2=$P(^(0),U,3) W !
    10 DIE     S DR="[PRCA COMMENT]",DIE="^PRCA(433,",DA=PRCAEN D ^DIE K DIE,DR,DA
    11         I $P($G(^PRCA(433,PRCAEN,5)),"^",2)=""!'$P(^PRCA(433,PRCAEN,1),"^") S PRCACOMM="TRANSACTION INCOMPLETE" D DELETE^PRCAWO1 K PRCACOMM G:$D(DTOUT) Q G ADJUST
    12         W ! W:$D(IOF) @IOF S D0=PRCAEN K DXS D ^PRCATO4 K DXS
    13         I $P($G(^PRCA(433,PRCAEN,1)),"^")>$P($G(^(5)),"^",3),$P($G(^(5)),"^",3) W !!,*7,"You entered a date of follow-up before the date of contact!" S PRCACOMM="INVALID FOLLOW-UP DATE" D DELETE^PRCAWO1 K PRCACOMM G ADJUST
    14 ASK     S %=2 W !!,"Is this correct" D YN^DICN I %=0 W !,"Answer 'Y' or 'YES' if this data is correct, answer 'N' or 'NO' if not",! G ASK
    15         I (%<0)!(%=2) S PRCACOMM="USER CANCELED" D DELETE^PRCAWO1 K PRCACOMM G ADJUST
    16 DONE    I '$D(PRCAD("DELETE")) S RCASK=1 D TRANUP^PRCAUTL,UPPRIN^PRCADJ
    17         I $P($G(^RCD(340,+$P(^PRCA(430,PRCABN,0),"^",9),0)),"^")[";DPT(" D
    18         .S $P(^PRCA(433,PRCAEN,0),"^",10)=1
    19         .S DIR(0)="Y",DIR("A")="Should the BRIEF COMMENT print on the patient statement",DIR("B")="NO" D ^DIR K DIR
    20         .I Y=1 S DIR(0)="Y",DIR("A")="Are you SURE this BRIEF COMMENT should appear on the patient statement",DIR("B")="NO" D ^DIR K DIR I Y=1 D
    21         ..W !!,*7,"*** OK, This comment will appear on the patient's statement! ***",!,"(If you change your mind, use the option Remove/Add Comment From Patient Statement)",!
    22         ..S $P(^PRCA(433,PRCAEN,0),"^",10)=""
    23         ..Q
    24         .Q
    25         G ADJUST
    26 Q       Q
    27 EN1     Q:'$D(PRCABN)
    28         NEW X
    29         F X=0:0 S X=$O(^PRCA(433,"C",PRCABN,X)) Q:'X  I $P($G(^PRCA(433,X,1)),"^",4) I $P(^(1),"^",2)=1!($P(^(1),"^",2)=35) S PRCAQNM=$P(^(1),"^",4)+1
    30         Q
    31 ASK1    ;ASK FOR STATUS
    32         NEW DTOUT,DUOUT,DIRUT,DIR,DIROUT
    33         S DIR("A")="Change 'BILL' status to?",DIR("B")="CANCELLED",DIR(0)="SB^1:CANCELLED;2:COLLECTED/CLOSED;" D ^DIR K DIR
    34         I Y=2 S PRCA("STATUS")=$O(^PRCA(430.3,"AC",108,0))
    35         Q
    36 RPT     ;
    37         NEW %DT,BEG,END,DIC,L,FR,TO,FLDS,PRCACM,POP,PRCADEV
    38 ST      W !! S %DT="AEX",%DT("A")="Follow-up Date(s) From: " D ^%DT G:Y<0 REPQ S BEG=Y
    39         S %DT="AEX",%DT("A")="Follow-up Date(s)   To: " D ^%DT G:Y<0 REPQ S END=Y
    40         I BEG>END W !!,*7,"  (Ending date must be greater than Start date.)" G ST
    41         S %ZIS="MQ" D ^%ZIS G:POP REPQ S PRCADEV=ION_";"_IOST_";"_IOM_";"_IOSL_";"_$G(IO("DOC"))
    42         I $D(IO("Q")) S Y=$$TI() G:Y<0 REPQ F PRCACM=1,2 S ZTDTH=$H,ZTRTN="DQ"_PRCACM_"^PRCACM",ZTSAVE("BEG")="",ZTSAVE("PRCADEV")="",ZTSAVE("END")="",ZTDESC="Comment Follow-up List" D ^%ZTLOAD G REPQ:PRCACM=2
    43         D DQ1,DQ2:'$D(DTOUT)
    44 REPQ    Q
    45 DQ1     ;
    46         S IOP=PRCADEV,DIC="^PRCA(433,",L=0,BY="[PRCA FOLLOW-UP]",FLDS="[PRCA FOLLOW-UP]",FR=BEG,TO=END D EN1^DIP
    47         D ^%ZISC K IOP
    48         I $E(IOST)="C" W !,*7,"OK, first part of report complete...",!,"press return to continue: " R X:DTIME W @IOF S:X["^"!'$T DTOUT=1
    49         Q
    50 DQ2     ;
    51         S IOP=PRCADEV D ^%ZIS
    52         I 'POP S IOP=PRCADEV,DIC="^RC(341,",L=0,BY="[RCAM COMMENT]",FLDS="[RCAM COMMENT]",FR=BEG,TO=END D EN1^DIP
    53         D ^%ZISC K IOP
    54         Q
    55 TI()    ;
    56         N %DT D NOW^%DTC S %DT("A")="Request Time to Queue? ",%DT("B")="NOW"
    57         S %DT="AERX",%DT(0)=% D ^%DT
    58         Q Y
    59 BEGIN   K PRCATERM,PRCABN,PRCAEN,PRCA("CKSITE"),PRCAIBS D BILL^PRCAUTL Q:('$D(PRCABN))
    60         S PRCAIBS=$P($G(^DGCR(399,PRCABN,0)),U,13)        ; IB claim status - DBIA3820-A
    61         I PRCAIBS=1 W !!,"**  You cannot add AR Comments to an Entered/Not Reviewed claim.  **",!,*7 G BEGIN
    62         I PRCAIBS=2 W !!,"**  You cannot add AR Comments to an MRA Request claim.  **",!,*7 G BEGIN
    63         I '$D(^PRCA(430,PRCABN,2,0)),PRCAIBS=7 W !!,"**  You cannot add AR Comments to a claim Cancelled/not passed to AR.  **",!,*7 G BEGIN
    64         I $P($G(^PRCA(430,PRCABN,0)),"^",8)=49 W !!,"**  Comments CANNOT be entered on an ARCHIVED bill.  **",!,*7 G BEGIN
    65         D SETTR^PRCAUTL,PATTR^PRCAUTL S DIC="^PRCA(433," K PRCAMT,PRCAD("DELETE") Q
     1PRCACM ;WASH-ISC@ALTOONA,PA/RGY-COMMENT ADJUSTMENT TRANSACTION ;6/2/95  2:41 PM
     2V ;;4.5;Accounts Receivable;**8,67,125,169**;Mar 20, 1995
     3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
     4 ;This is a routine for adjustment transaction.
     5 NEW PRCABN,PRCAEN,PRCAA1,DR,DIE,DA,D0,PRCAD,RCASK,PRCAA2,DIROUT,DIRUT,DIR,DUOUT,PRCA,PRCATY
     6ADJUST D BEGIN G:('$D(PRCABN))!('$D(PRCAEN)) Q
     7 S PRCAA1=$S($D(^PRCA(433,PRCAEN,4,0)):+$P(^(0),U,4),1:0) G Q:PRCAA1'>0 S PRCAA2=$P(^(0),U,3) W !
     8DIE S DR="[PRCA COMMENT]",DIE="^PRCA(433,",DA=PRCAEN D ^DIE K DIE,DR,DA
     9 I $P($G(^PRCA(433,PRCAEN,5)),"^",2)=""!'$P(^PRCA(433,PRCAEN,1),"^") S PRCACOMM="TRANSACTION INCOMPLETE" D DELETE^PRCAWO1 K PRCACOMM G:$D(DTOUT) Q G ADJUST
     10 W ! W:$D(IOF) @IOF S D0=PRCAEN K DXS D ^PRCATO4 K DXS
     11 I $P($G(^PRCA(433,PRCAEN,1)),"^")>$P($G(^(5)),"^",3),$P($G(^(5)),"^",3) W !!,*7,"You entered a date of follow-up before the date of contact!" S PRCACOMM="INVALID FOLLOW-UP DATE" D DELETE^PRCAWO1 K PRCACOMM G ADJUST
     12ASK S %=2 W !!,"Is this correct" D YN^DICN I %=0 W !,"Answer 'Y' or 'YES' if this data is correct, answer 'N' or 'NO' if not",! G ASK
     13 I (%<0)!(%=2) S PRCACOMM="USER CANCELED" D DELETE^PRCAWO1 K PRCACOMM G ADJUST
     14DONE I '$D(PRCAD("DELETE")) S RCASK=1 D TRANUP^PRCAUTL,UPPRIN^PRCADJ
     15 I $P($G(^RCD(340,+$P(^PRCA(430,PRCABN,0),"^",9),0)),"^")[";DPT(" D
     16 .S $P(^PRCA(433,PRCAEN,0),"^",10)=1
     17 .S DIR(0)="Y",DIR("A")="Should the BRIEF COMMENT print on the patient statement",DIR("B")="NO" D ^DIR K DIR
     18 .I Y=1 S DIR(0)="Y",DIR("A")="Are you SURE this BRIEF COMMENT should appear on the patient statement",DIR("B")="NO" D ^DIR K DIR I Y=1 D
     19 ..W !!,*7,"*** OK, This comment will appear on the patient's statement! ***",!,"(If you change your mind, use the option Remove/Add Comment From Patient Statement)",!
     20 ..S $P(^PRCA(433,PRCAEN,0),"^",10)=""
     21 ..Q
     22 .Q
     23 G ADJUST
     24Q Q
     25EN1 Q:'$D(PRCABN)
     26 NEW X
     27 F X=0:0 S X=$O(^PRCA(433,"C",PRCABN,X)) Q:'X  I $P($G(^PRCA(433,X,1)),"^",4) I $P(^(1),"^",2)=1!($P(^(1),"^",2)=35) S PRCAQNM=$P(^(1),"^",4)+1
     28 Q
     29ASK1 ;ASK FOR STATUS
     30 NEW DTOUT,DUOUT,DIRUT,DIR,DIROUT
     31 S DIR("A")="Change 'BILL' status to?",DIR("B")="CANCELLED",DIR(0)="SB^1:CANCELLED;2:COLLECTED/CLOSED;" D ^DIR K DIR
     32 I Y=2 S PRCA("STATUS")=$O(^PRCA(430.3,"AC",108,0))
     33 Q
     34RPT ;
     35 NEW %DT,BEG,END,DIC,L,FR,TO,FLDS,PRCACM,POP,PRCADEV
     36ST W !! S %DT="AEX",%DT("A")="Follow-up Date(s) From: " D ^%DT G:Y<0 REPQ S BEG=Y
     37 S %DT="AEX",%DT("A")="Follow-up Date(s)   To: " D ^%DT G:Y<0 REPQ S END=Y
     38 I BEG>END W !!,*7,"  (Ending date must be greater than Start date.)" G ST
     39 S %ZIS="MQ" D ^%ZIS G:POP REPQ S PRCADEV=ION_";"_IOST_";"_IOM_";"_IOSL_";"_$G(IO("DOC"))
     40 I $D(IO("Q")) S Y=$$TI() G:Y<0 REPQ F PRCACM=1,2 S ZTDTH=$H,ZTRTN="DQ"_PRCACM_"^PRCACM",ZTSAVE("BEG")="",ZTSAVE("PRCADEV")="",ZTSAVE("END")="",ZTDESC="Comment Follow-up List" D ^%ZTLOAD G REPQ:PRCACM=2
     41 D DQ1,DQ2:'$D(DTOUT)
     42REPQ Q
     43DQ1 ;
     44 S IOP=PRCADEV,DIC="^PRCA(433,",L=0,BY="[PRCA FOLLOW-UP]",FLDS="[PRCA FOLLOW-UP]",FR=BEG,TO=END D EN1^DIP
     45 D ^%ZISC K IOP
     46 I $E(IOST)="C" W !,*7,"OK, first part of report complete...",!,"press return to continue: " R X:DTIME W @IOF S:X["^"!'$T DTOUT=1
     47 Q
     48DQ2 ;
     49 S IOP=PRCADEV D ^%ZIS
     50 I 'POP S IOP=PRCADEV,DIC="^RC(341,",L=0,BY="[RCAM COMMENT]",FLDS="[RCAM COMMENT]",FR=BEG,TO=END D EN1^DIP
     51 D ^%ZISC K IOP
     52 Q
     53TI() ;
     54 N %DT D NOW^%DTC S %DT("A")="Request Time to Queue? ",%DT("B")="NOW"
     55 S %DT="AERX",%DT(0)=% D ^%DT
     56 Q Y
     57BEGIN K PRCATERM,PRCABN,PRCAEN,PRCA("CKSITE") D BILL^PRCAUTL Q:('$D(PRCABN))
     58 I '$D(^PRCA(430,PRCABN,2,0)) W !!,"**  This bill was cancelled in IB before it was passed to AR.  **",!,*7 G BEGIN
     59 I $P($G(^PRCA(430,PRCABN,0)),"^",8)=49 W !!,"**  Comments CANNOT be entered on an ARCHIVED bill.  **",!,*7 G BEGIN
     60 D SETTR^PRCAUTL,PATTR^PRCAUTL S DIC="^PRCA(433," K PRCAMT,PRCAD("DELETE") Q
Note: See TracChangeset for help on using the changeset viewer.