| 1 | RCEVGEN ;WASH-ISC@ALTOONA,PA/RGY-Account Management Adjustment ; 7/3/03 2:03pm
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**198**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN(TYPE) ;
|
|---|
| 5 | DEB ;Make an adjustment to a debtor account
|
|---|
| 6 | N DLAYGO,DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
|
|---|
| 7 | S DIC="^RCD(340,",DIC(0)="QEAML",DLAYGO=340 D ^DIC I Y>0 D ADJ(+Y,$G(TYPE))
|
|---|
| 8 | Q
|
|---|
| 9 | ADJ(DEBT,TYPE) ;Adjust an account for DEBT (340 entry)
|
|---|
| 10 | NEW DIC,DA,X,Y,ERR,EVN,DIE,DR
|
|---|
| 11 | S SITE=$$SITE^RCMSITE() G:SITE'>0 Q2
|
|---|
| 12 | S DEBT=$P($G(^RCD(340,+$G(DEBT),0)),"^") G:'DEBT Q2
|
|---|
| 13 | I $G(TYPE)="" S DIC="^RC(341.1,",DIC(0)="QEAMZ",DIC("S")="I $G(^(1))]""""",DIC("A")="Type of EVENT or ADJUSTMENT: " D ^DIC G:Y<0 Q2 S TYPE=$P(Y(0),"^",2)
|
|---|
| 14 | D OPEN^RCEVDRV1(TYPE,DEBT,DT,DUZ,SITE,.ERR,.EVN)
|
|---|
| 15 | I ERR]""!(EVN<0) W !,"*** Oops, I experienced an error (",ERR,") trying to open a new event ***",! G Q2
|
|---|
| 16 | W !,"...OK, reference number assigned: ",$P(^RC(341,EVN,0),"^"),!
|
|---|
| 17 | EDT S DR=$P($G(^RC(341.1,$O(^RC(341.1,"AC",TYPE,0)),1)),"^"),DIE="^RC(341,",DA=EVN D:DR]"" ^DIE
|
|---|
| 18 | S X=$$OK(EVN) G:X=0 EDT I X<0!(X["^") D DEL^RCEVDRV1(EVN) W " ... OK, Deleted",! G Q2
|
|---|
| 19 | D CLOSE^RCEVDRV1(EVN,.ERR)
|
|---|
| 20 | I ERR]"" W !,"*** Oops, I experienced an error ("_ERR_")",!,"... trying to close this event ***"
|
|---|
| 21 | Q2 Q
|
|---|
| 22 | OK(EVN) ;OK an event or delete it
|
|---|
| 23 | NEW L,FLDS,BY,TO,DIC,IOP,DIR,DIRUT,DIROUT,DUOUT
|
|---|
| 24 | S L=0,FLDS=$P($G(^RC(341.1,+$O(^RC(341.1,"AC",+$P($G(^RC(341,EVN,0)),"^",2),0)),1)),"^",2),BY="@NUMBER",(FR,TO)=EVN,IOP=ION,DIC="^RC(341," D:FLDS]"" EN1^DIP
|
|---|
| 25 | W ! S DIR(0)="YA",DIR("B")="YES",DIR("A")="Is this OK? " D ^DIR K DIR
|
|---|
| 26 | S:$D(DTOUT) Y=-1
|
|---|
| 27 | Q Y
|
|---|
