source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCFMPUR.m@ 1006

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

initial load of WorldVistAEHR

File size: 771 bytes
Line 
1RCFMPUR ;WASH-ISC@ALTOONA,PA/RGY-Purge AR Documents to FMS ;9/28/94 2:09 PM
2V ;;4.5;Accounts Receivable;;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4EN ;
5 NEW %DT,PURDT,DATE
6 S X="T-34" D ^%DT S PURDT=Y
7 S DATE=0 F S DATE=$O(^RC(347,"AD",DATE)) Q:DATE>PURDT!'DATE S DOC=0 F S DOC=$O(^RC(347,"AD",DATE,DOC)) Q:'DOC D
8 .S STAT=$P($G(^RC(347,DOC,0)),"^",3)
9 .I ",0,1,3,"[(","_STAT_",") Q
10 .D DEL(DOC)
11 .Q
12 Q
13DEL(DOC) ;Delete an FMS document
14 NEW DIK,DA,STA,N0
15 I $G(DOC)'?1N.N Q
16 S N0=$G(^RC(347,DOC,0))
17 I N0="" Q
18 S STA=$P($G(^RC(347.1,+$P(N0,"^",2),0)),"^",2)_"-"_$P(N0,"^",9)_$E(" ",1,11-$L($P(N0,"^",9)))_$S($P(N0,"^",10)]"":"-"_$P(N0,"^",10),1:"")
19 D KILLCS^GECSSDCT(STA)
20 S DA=DOC,DIK="^RC(347," D ^DIK
21 Q
Note: See TracBrowser for help on using the repository browser.