XIPENV ;ALB/BRM,OIFO/SO - STANDARD ENVIRONMENT CHK FOR XIP PACKAGE;12:02 PM 8 Jul 2003
;;8.0;KERNEL;**292**;Jul 10, 1995
;
; This routine is executed from the top for the environment check
; portion of the install.
ENVCHK ; Environment check to ensure the STATE file has all of the
; necessary entries to properly point the 5.12 and 5.13 files to
; the appropriate entry.
;
N TAG,DATA,SFIPS,ST,STATE,FIXST,OLDST,IEN5,DISPTXT
STCHK ; Check STATE(#5) for problems
F TAG=1:1 Q:TAG=99999 I $T(@TAG)]"" D
.S DATA=$P($T(@TAG),";;",2),ST=$P(DATA,"^",2)
.S STATE=$P(DATA,"^"),SFIPS=$P(DATA,"^",3)
.S IEN5=$O(^DIC(5,"C",ST,""))
.S:'IEN5 IEN5=$O(^DIC(5,"B",STATE,""))
.S:'IEN5 IEN5=$O(^DIC(5,"C",SFIPS,""))
.Q:$P($G(^DIC(5,+IEN5,0)),"^",1,3)=DATA
.S OLDSTATE=$P($G(^DIC(5,+IEN5,0)),"^",2) S:OLDSTATE="" OLDSTATE=0_"^"_ST
.S FIXST(ST)=DATA,OLDST(OLDSTATE)=$P($G(^DIC(5,+IEN5,0)),"^",1,3)
I '$D(FIXST) D MES^XPDUTL(" Your STATE(#5) file is fine.") Q
S XPDQUIT=2
D BMES^XPDUTL(" ******************************************************************")
D MES^XPDUTL(" The following State file (#5) entries are missing or need editing.")
D MES^XPDUTL(" If you uncomfortable using the instructions in the patch to make the")
D MES^XPDUTL(" corrections, please log a NOIS for assistance in resolving this issue.")
D BMES^XPDUTL(" ******************************************************************")
D BMES^XPDUTL(" Your site shows the following:")
D MES^XPDUTL(" ABBREVIATION VA STATE CODE STATE NAME")
D MES^XPDUTL(" ------------ ------------- ----------")
S ST="" F S ST=$O(OLDST(ST)) Q:ST="" D
.S DISPTXT=" "_$J($P(OLDST(ST),"^",2),7)_" "_$J($P(OLDST(ST),"^",3),7)_" "_$P(OLDST(ST),"^")
.D MES^XPDUTL(DISPTXT)
D BMES^XPDUTL(" The below entries should be added and/or corrected as follows:")
D MES^XPDUTL(" ABBREVIATION VA STATE CODE STATE NAME")
D MES^XPDUTL(" ------------ ------------- ----------")
S ST="" F S ST=$O(FIXST(ST)) Q:ST="" D
.D MES^XPDUTL(" "_$J($P(FIXST(ST),"^",2),7)_" "_$J($P(FIXST(ST),"^",3),7)_" "_$P(FIXST(ST),"^"))
;
PTCHK ; Check 5.12 & 5.13 for unknown "PT" nodes
; IA# 4136
I $D(^DD(5.12,0,"PT")) D
. N FILE
. S FILE=0
. F S FILE=$O(^DD(5.12,0,"PT",FILE)) Q:'FILE D
.. N FIELD
.. S FIELD=0
.. F S FIELD=$O(^DD(5.12,0,"PT",FILE,FIELD)) Q:'FIELD D
... N X
... S X=" File #: "_FILE_" Field #: "_FIELD_" is Pointing To File # 5.12. Please remove this dependency!"
... D MES^XPDUTL(X) S XPDQUIT=1
;
; IA# 4137
N FILE
S FILE=0
F S FILE=$O(^DD(5.13,0,"PT",FILE)) Q:'FILE I FILE'=5.12 D
. N FIELD
. S FIELD=0
. F S FIELD=$O(^DD(5.13,0,"PT",FILE,FIELD)) Q:'FIELD D
.. N X
.. S X=" File #: "_FILE_" Field #: "_FIELD_" is Pointing To File # 5.13. Please remove this dependency!"
.. D MES^XPDUTL(X) S XPDQUIT=2
I '$D(XPDQUIT) D
. N X
. S X="Your STATE(#5) file is fine. No unknown ""PT"" where found. Continuing the installation."
. D MES^XPDUTL(X)
;
; End of Envirment Check
Q
;
; **** Below Data is used to validate state file - do not modify ****
; The '^' pieces are as follows:
; $P(#1)=NAME, $P(#2)=ABBV, and $P(#3)=VA STATE CODE
1 ;;ALABAMA^AL^01
2 ;;ALASKA^AK^02
4 ;;ARIZONA^AZ^04
5 ;;ARKANSAS^AR^05
6 ;;CALIFORNIA^CA^06
8 ;;COLORADO^CO^08
9 ;;CONNECTICUT^CT^09
10 ;;DELAWARE^DE^10
11 ;;DISTRICT OF COLUMBIA^DC^11
12 ;;FLORIDA^FL^12
13 ;;GEORGIA^GA^13
15 ;;HAWAII^HI^15
16 ;;IDAHO^ID^16
17 ;;ILLINOIS^IL^17
18 ;;INDIANA^IN^18
19 ;;IOWA^IA^19
20 ;;KANSAS^KS^20
21 ;;KENTUCKY^KY^21
22 ;;LOUISIANA^LA^22
23 ;;MAINE^ME^23
24 ;;MARYLAND^MD^24
25 ;;MASSACHUSETTS^MA^25
26 ;;MICHIGAN^MI^26
27 ;;MINNESOTA^MN^27
28 ;;MISSISSIPPI^MS^28
29 ;;MISSOURI^MO^29
30 ;;MONTANA^MT^30
31 ;;NEBRASKA^NE^31
32 ;;NEVADA^NV^32
33 ;;NEW HAMPSHIRE^NH^33
34 ;;NEW JERSEY^NJ^34
35 ;;NEW MEXICO^NM^35
36 ;;NEW YORK^NY^36
37 ;;NORTH CAROLINA^NC^37
38 ;;NORTH DAKOTA^ND^38
39 ;;OHIO^OH^39
40 ;;OKLAHOMA^OK^40
41 ;;OREGON^OR^41
42 ;;PENNSYLVANIA^PA^42
44 ;;RHODE ISLAND^RI^44
45 ;;SOUTH CAROLINA^SC^45
46 ;;SOUTH DAKOTA^SD^46
47 ;;TENNESSEE^TN^47
48 ;;TEXAS^TX^48
49 ;;UTAH^UT^49
50 ;;VERMONT^VT^50
51 ;;VIRGINIA^VA^51
53 ;;WASHINGTON^WA^53
54 ;;WEST VIRGINIA^WV^54
55 ;;WISCONSIN^WI^55
56 ;;WYOMING^WY^56
60 ;;AMERICAN SAMOA^AS^60
64 ;;FEDERATED STATES OF MICRONESIA^FM^64
66 ;;GUAM^GU^66
68 ;;MARSHALL ISLANDS^MH^68
69 ;;NORTHERN MARIANA ISLANDS^MP^69
70 ;;PALAU^PW^70
72 ;;PUERTO RICO^PR^72
78 ;;VIRGIN ISLANDS^VI^78
85 ;;ARMED FORCES AMER (EXC CANADA)^AA^85
87 ;;ARMED FORCES AF,EU,ME,CA^AE^87
88 ;;ARMED FORCES PACIFIC^AP^88
99999 ;;LAST LINE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXIPENV 4749 printed Sep 23, 2025@19:38:32 Page 2
XIPENV ;ALB/BRM,OIFO/SO - STANDARD ENVIRONMENT CHK FOR XIP PACKAGE;12:02 PM 8 Jul 2003
+1 ;;8.0;KERNEL;**292**;Jul 10, 1995
+2 ;
+3 ; This routine is executed from the top for the environment check
+4 ; portion of the install.
ENVCHK ; Environment check to ensure the STATE file has all of the
+1 ; necessary entries to properly point the 5.12 and 5.13 files to
+2 ; the appropriate entry.
+3 ;
+4 NEW TAG,DATA,SFIPS,ST,STATE,FIXST,OLDST,IEN5,DISPTXT
STCHK ; Check STATE(#5) for problems
+1 FOR TAG=1:1
if TAG=99999
QUIT
IF $TEXT(@TAG)]""
Begin DoDot:1
+2 SET DATA=$PIECE($TEXT(@TAG),";;",2)
SET ST=$PIECE(DATA,"^",2)
+3 SET STATE=$PIECE(DATA,"^")
SET SFIPS=$PIECE(DATA,"^",3)
+4 SET IEN5=$ORDER(^DIC(5,"C",ST,""))
+5 if 'IEN5
SET IEN5=$ORDER(^DIC(5,"B",STATE,""))
+6 if 'IEN5
SET IEN5=$ORDER(^DIC(5,"C",SFIPS,""))
+7 if $PIECE($GET(^DIC(5,+IEN5,0)),"^",1,3)=DATA
QUIT
+8 SET OLDSTATE=$PIECE($GET(^DIC(5,+IEN5,0)),"^",2)
if OLDSTATE=""
SET OLDSTATE=0_"^"_ST
+9 SET FIXST(ST)=DATA
SET OLDST(OLDSTATE)=$PIECE($GET(^DIC(5,+IEN5,0)),"^",1,3)
End DoDot:1
+10 IF '$DATA(FIXST)
DO MES^XPDUTL(" Your STATE(#5) file is fine.")
QUIT
+11 SET XPDQUIT=2
+12 DO BMES^XPDUTL(" ******************************************************************")
+13 DO MES^XPDUTL(" The following State file (#5) entries are missing or need editing.")
+14 DO MES^XPDUTL(" If you uncomfortable using the instructions in the patch to make the")
+15 DO MES^XPDUTL(" corrections, please log a NOIS for assistance in resolving this issue.")
+16 DO BMES^XPDUTL(" ******************************************************************")
+17 DO BMES^XPDUTL(" Your site shows the following:")
+18 DO MES^XPDUTL(" ABBREVIATION VA STATE CODE STATE NAME")
+19 DO MES^XPDUTL(" ------------ ------------- ----------")
+20 SET ST=""
FOR
SET ST=$ORDER(OLDST(ST))
if ST=""
QUIT
Begin DoDot:1
+21 SET DISPTXT=" "_$JUSTIFY($PIECE(OLDST(ST),"^",2),7)_" "_$JUSTIFY($PIECE(OLDST(ST),"^",3),7)_" "_$PIECE(OLDST(ST),"^")
+22 DO MES^XPDUTL(DISPTXT)
End DoDot:1
+23 DO BMES^XPDUTL(" The below entries should be added and/or corrected as follows:")
+24 DO MES^XPDUTL(" ABBREVIATION VA STATE CODE STATE NAME")
+25 DO MES^XPDUTL(" ------------ ------------- ----------")
+26 SET ST=""
FOR
SET ST=$ORDER(FIXST(ST))
if ST=""
QUIT
Begin DoDot:1
+27 DO MES^XPDUTL(" "_$JUSTIFY($PIECE(FIXST(ST),"^",2),7)_" "_$JUSTIFY($PIECE(FIXST(ST),"^",3),7)_" "_$PIECE(FIXST(ST),"^"))
End DoDot:1
+28 ;
PTCHK ; Check 5.12 & 5.13 for unknown "PT" nodes
+1 ; IA# 4136
+2 IF $DATA(^DD(5.12,0,"PT"))
Begin DoDot:1
+3 NEW FILE
+4 SET FILE=0
+5 FOR
SET FILE=$ORDER(^DD(5.12,0,"PT",FILE))
if 'FILE
QUIT
Begin DoDot:2
+6 NEW FIELD
+7 SET FIELD=0
+8 FOR
SET FIELD=$ORDER(^DD(5.12,0,"PT",FILE,FIELD))
if 'FIELD
QUIT
Begin DoDot:3
+9 NEW X
+10 SET X=" File #: "_FILE_" Field #: "_FIELD_" is Pointing To File # 5.12. Please remove this dependency!"
+11 DO MES^XPDUTL(X)
SET XPDQUIT=1
End DoDot:3
End DoDot:2
End DoDot:1
+12 ;
+13 ; IA# 4137
+14 NEW FILE
+15 SET FILE=0
+16 FOR
SET FILE=$ORDER(^DD(5.13,0,"PT",FILE))
if 'FILE
QUIT
IF FILE'=5.12
Begin DoDot:1
+17 NEW FIELD
+18 SET FIELD=0
+19 FOR
SET FIELD=$ORDER(^DD(5.13,0,"PT",FILE,FIELD))
if 'FIELD
QUIT
Begin DoDot:2
+20 NEW X
+21 SET X=" File #: "_FILE_" Field #: "_FIELD_" is Pointing To File # 5.13. Please remove this dependency!"
+22 DO MES^XPDUTL(X)
SET XPDQUIT=2
End DoDot:2
End DoDot:1
+23 IF '$DATA(XPDQUIT)
Begin DoDot:1
+24 NEW X
+25 SET X="Your STATE(#5) file is fine. No unknown ""PT"" where found. Continuing the installation."
+26 DO MES^XPDUTL(X)
End DoDot:1
+27 ;
+28 ; End of Envirment Check
+29 QUIT
+30 ;
+31 ; **** Below Data is used to validate state file - do not modify ****
+32 ; The '^' pieces are as follows:
+33 ; $P(#1)=NAME, $P(#2)=ABBV, and $P(#3)=VA STATE CODE
1 ;;ALABAMA^AL^01
2 ;;ALASKA^AK^02
4 ;;ARIZONA^AZ^04
5 ;;ARKANSAS^AR^05
6 ;;CALIFORNIA^CA^06
8 ;;COLORADO^CO^08
9 ;;CONNECTICUT^CT^09
10 ;;DELAWARE^DE^10
11 ;;DISTRICT OF COLUMBIA^DC^11
12 ;;FLORIDA^FL^12
13 ;;GEORGIA^GA^13
15 ;;HAWAII^HI^15
16 ;;IDAHO^ID^16
17 ;;ILLINOIS^IL^17
18 ;;INDIANA^IN^18
19 ;;IOWA^IA^19
20 ;;KANSAS^KS^20
21 ;;KENTUCKY^KY^21
22 ;;LOUISIANA^LA^22
23 ;;MAINE^ME^23
24 ;;MARYLAND^MD^24
25 ;;MASSACHUSETTS^MA^25
26 ;;MICHIGAN^MI^26
27 ;;MINNESOTA^MN^27
28 ;;MISSISSIPPI^MS^28
29 ;;MISSOURI^MO^29
30 ;;MONTANA^MT^30
31 ;;NEBRASKA^NE^31
32 ;;NEVADA^NV^32
33 ;;NEW HAMPSHIRE^NH^33
34 ;;NEW JERSEY^NJ^34
35 ;;NEW MEXICO^NM^35
36 ;;NEW YORK^NY^36
37 ;;NORTH CAROLINA^NC^37
38 ;;NORTH DAKOTA^ND^38
39 ;;OHIO^OH^39
40 ;;OKLAHOMA^OK^40
41 ;;OREGON^OR^41
42 ;;PENNSYLVANIA^PA^42
44 ;;RHODE ISLAND^RI^44
45 ;;SOUTH CAROLINA^SC^45
46 ;;SOUTH DAKOTA^SD^46
47 ;;TENNESSEE^TN^47
48 ;;TEXAS^TX^48
49 ;;UTAH^UT^49
50 ;;VERMONT^VT^50
51 ;;VIRGINIA^VA^51
53 ;;WASHINGTON^WA^53
54 ;;WEST VIRGINIA^WV^54
55 ;;WISCONSIN^WI^55
56 ;;WYOMING^WY^56
60 ;;AMERICAN SAMOA^AS^60
64 ;;FEDERATED STATES OF MICRONESIA^FM^64
66 ;;GUAM^GU^66
68 ;;MARSHALL ISLANDS^MH^68
69 ;;NORTHERN MARIANA ISLANDS^MP^69
70 ;;PALAU^PW^70
72 ;;PUERTO RICO^PR^72
78 ;;VIRGIN ISLANDS^VI^78
85 ;;ARMED FORCES AMER (EXC CANADA)^AA^85
87 ;;ARMED FORCES AF,EU,ME,CA^AE^87
88 ;;ARMED FORCES PACIFIC^AP^88
99999 ;;LAST LINE
