| 1 | RCY159EN ;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
|
|---|
| 32 | MES ;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
|
|---|
| 37 | MES1 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
|
|---|
