source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAI217.m@ 1556

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

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1PRCAI217 ;ALB/CXW - PRCA*4.5*217 POST-INIT ROUTINE
2 ;;4.5;Accounts Receivable;**217**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5EN ;convert the data stored in the global DISV(DUZ,"RCDPRPLM") file to the
6 ;AR USER CUSTOMIZE file (#342.3).
7 ;^RC(342.3,da,0)=screen/options
8 ;^RC(342.3,da,1,da(1),0)=duz^selection^device
9 ;
10 N RCDUZ,RCSNOPT,RCREC,RCSEL,RCDEV,U,DA,X,DIC,DIE,DR
11 W !
12 W "PRCA*4.5*217 Post Install......",!
13 W "Converting the data stored in the ^DISV(DUZ,""RCDPRPLM"") global to",!
14 W "the AR USER CUSTOMIZE file (#342.3)."
15 S RCDUZ=0,U="^"
16 F S RCDUZ=$O(^DISV(RCDUZ)) Q:'RCDUZ I $D(^DISV(RCDUZ,"RCDPRPLM")) D
17 .S RCSNOPT=""
18 .L +^DISV(RCDUZ,"RCDPRPLM"):5
19 .F S RCSNOPT=$O(^DISV(RCDUZ,"RCDPRPLM",RCSNOPT)) Q:RCSNOPT="" D
20 ..S RCREC=$G(^DISV(RCDUZ,"RCDPRPLM",RCSNOPT))
21 ..I '$D(^RC(342.3,"B",RCSNOPT)) D
22 ...K DD,DO,DIC("DR") S DIC="^RC(342.3,",DIC(0)="",X=RCSNOPT
23 ...D FILE^DICN
24 ..S RCSEL=$S(RCSNOPT="215REPORT":"",1:$P(RCREC,U))
25 ..S RCDEV=$S(RCSNOPT="RECEIPT":$P(RCREC,U,2),RCSNOPT="215REPORT":$P(RCREC,U),1:"")
26 ..S DA(1)=$O(^RC(342.3,"B",RCSNOPT,0))
27 ..;if new then add entry
28 ..I '$D(^RC(342.3,DA(1),1,"B",RCDUZ)) D Q
29 ...S DIC(0)="",DIC("P")=$P(^DD(342.3,1,0),U,2)
30 ...S DIC="^RC(342.3,"_DA(1)_",1,"
31 ...S X=RCDUZ
32 ...S DIC("DR")="1////"_RCSEL_";2////"_RCDEV
33 ...K DD,DO D FILE^DICN
34 ...;
35 ..;if existing then edit entry
36 ..S DA=$O(^RC(342.3,DA(1),1,"B",RCDUZ,0)),DR=".01////"_RCDUZ_";1////"_RCSEL_";2////"_RCDEV
37 ..S DIE="^RC(342.3,"_DA(1)_",1," D ^DIE
38 .W "."
39 .L -^DISV(RCDUZ,"RCDPRPLM")
40 W "Done!"
41 Q
Note: See TracBrowser for help on using the repository browser.