source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCY159EN.m@ 1141

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1RCY159EN ;MAF/ALB - ENVIRONMENT CHECK FOR PATCH PRCA*159 AR/RCI ;APR 2,2004
2 ;;4.5;Accounts Receivable;**159**;Mar 20, 1995
3 D BMES^XPDUTL("This Environment check checks to see if field (32) REMOTE DOMAIN ")
4 D MES^XPDUTL("in file (349.1) AR TRANSMISSIONS TYPE is populated.")
5 D MES^XPDUTL("This field must be populated to complete the install.")
6 D MES^XPDUTL("")
7 D BMES^XPDUTL("...Checking Regional Counsel REMOTE DOMAIN field 32.")
8 ; find the primary RC mail address from file 349.1 field 33
9 N RCDOM,RCIFN,RCFLAG
10 S RCFLAG=0
11 ;I $D(^RCT(349.1,"B","RC")) S RCIFN=$O(^RCT(349.1,"B","RC",0)) I RCIFN]"" D Q:RCFLAG
12 I $D(^RCT(349.1,"B","RC")) S RCIFN=$O(^RCT(349.1,"B","RC",0)) I RCIFN]"" D
13 .S RCDOM=$P($G(^RCT(349.1,RCIFN,3)),"^",3)
14 .I RCDOM]""&($E(RCDOM,1,3)="RC-") D BMES^XPDUTL("...REMOTE DOMAIN populated... ") Q
15 .I RCDOM]"" D MES1
16 .I RCDOM="" D BMES^XPDUTL("...There is no Regional Counsel REMOTE DOMAIN entry.") D
17 ..D BMES^XPDUTL("...Please update field (32) REMOTE DOMAIN in AR TRANSMISSION TYPE file (349.1)") D MES^XPDUTL(" for the Regional Counsel (RC) type of transmission.")
18 .D MES
19 .Q
20 ;CHECKING THE DIVISION OF CARE FIELD (61) SUBFIELD (.02) REMOTE DOMAIN
21 I $D(^RCT(349.1,RCIFN,6,0)),$O(^RCT(349.1,RCIFN,6,0)) D
22 .D BMES^XPDUTL(" ") D BMES^XPDUTL("Checking field (61) DIVISION OF CARE subfield (.02) REMOTE DOMAIN") D MES^XPDUTL("This field must be populated to complete the install")
23 .N RCNEW,RCNODE,RCDETH,RCDIVC,RCDVADD,RCDVIFN,X
24 .S RCDVIFN=0,RCFLAG=0
25 .F RCDIVC=0:0 S RCDVIFN=$O(^RCT(349.1,RCIFN,6,RCDVIFN)) Q:'RCDVIFN!(RCFLAG) S RCDVADD=$P($G(^RCT(349.1,RCIFN,6,RCDVIFN,0)),"^",2) D
26 ..I $G(RCDVADD)="" D BMES^XPDUTL("...Check/update subfield (.02) REMOTE DOMAIN in field (61) DIVISION OF CARE") D Q
27 ...D MES^XPDUTL(" in file 349.1 AR TRANSMISSION TYPE for all your divisions of care...") D BMES^XPDUTL(" ") D MES^XPDUTL("***The REMOTE DOMAIN must be populated with an address that starts with 'RC-'") D MES
28 ..I $G(RCDVADD)]""&($E($P($G(^DIC(4.2,RCDVADD,0)),U,1),1,3)="RC-") Q
29 ..I $G(RCDVADD)]"" D MES1,MES
30 I 'RCFLAG D BMES^XPDUTL(" Environment Check completed successfully... ")
31 Q
32MES ;D BMES^XPDUTL("...After file update, run 'Restart Install of Package(s)' under the Installation")
33 ;D MES^XPDUTL(" option of the Kernel Installation and Distributions System.") S XPDABORT=1,RCFLAG=1
34 D MES^XPDUTL(" Use option RC PARAMETERS EDIT [PRCA RC PARAMETERS] to update this field.")
35 S XPDABORT=1,RCFLAG=1
36 Q
37MES1 D BMES^XPDUTL("...The REMOTE DOMAIN field is incorrectly populated and will not be properly") D MES^XPDUTL(" converted to the new Regional Counsel mail address.")
38 D BMES^XPDUTL("***The REMOTE DOMAIN must be populated with an address that starts with 'RC-'")
39 Q
Note: See TracBrowser for help on using the repository browser.