XIPSYNC ;OIFOO/SO- SYNC UP FILE 5'S COUNTY MULTIPLE WITH 5.13;6:56 AM 16 Nov 2005
;;8.0;KERNEL;**328,378**;Jul 10, 1995;Build 59
Q
EP1 ;MAIN ENTRY POINT
N XIPQ S XIPQ=0 ;ALLOW DIALOG TO DISPLAY OR PRINT
;
N XUMF S XUMF=1 ;ALLOW EDITING ;8*378
;
D S1,S2
Q
;
DEQUE ;DEQUEUING ENTRY POINT
N XIPQ S XIPQ=1 ;KEEP DIALOG FROM DISPLAYING OR PRINTING
;
N XUMF S XUMF=1 ;ALLOW EDITING ;8*378
;
D S1,S2
Q
;
S1 ;SET INACTIVE DATE FOR ALL COUNTIES TO DT
N ST
S ST=0 ;ST=STATE IEN
I 'XIPQ D MES^XPDUTL("Begin updating COUNTY multiple...")
F S ST=$O(^DIC(5,ST)) Q:'ST D
. I +$P(^DIC(5,ST,0),U,3)>56,+$P(^(0),U,3)'=72 Q ;NOT US STATE OR PR
. N CO S CO=0 ;CO=COUNTY IEN
. F S CO=$O(^DIC(5,ST,1,CO)) Q:'CO D
.. I $P(^DIC(5,ST,1,CO,0),U,5)]"" Q ;DON'T CHANGE DATE
.. N FDA,DIERR,EM
.. S FDA(5.01,CO_","_ST_",",5)=DT
.. D FILE^DIE("","FDA","EM")
.. Q
Q
;
S2 ;EDIT COUNTY MULTIPLE USING FILE 5.13
N IEN,X,FST,FCO
;FST=2 DIGIT STATE FIPS CODE, FCO=3 DIGIT COUNTY FIPS CODE
S IEN=0 ;5.13'S IEN
F S IEN=$O(^XIP(5.13,IEN)) Q:'IEN S X=^XIP(5.13,IEN,0),FST=$E(X,1,2),FCO=$E(X,3,5) D
. N ST,CO
. S ST=0,CO=0
. S ST=$O(^DIC(5,"C",FST,ST))
. I 'ST,'XIPQ D MES^XPDUTL("Can not find STATE CODE: "_FST_" in STATE file.") Q
. S CO=$O(^DIC(5,ST,1,"C",FCO,CO))
. I 'CO D Q ;ADD COUNTY
.. N DIERR,EM,FDA
.. I 'XIPQ D MES^XPDUTL("Adding County: "_$P(X,U,2)_"("_FCO_")"_" to State: "_$$GET1^DIQ(5,ST_",",.01))
.. S FDA(5.01,"?+1,"_ST_",",.01)=$P(X,U,2)
.. S FDA(5.01,"?+1,"_ST_",",2)=FCO
.. D UPDATE^DIE("","FDA","","EM")
.. Q
. I CO D Q ;REACTIVATE COUNTY
.. N DIERR,EM,FDA
.. S FDA(5.01,CO_","_ST_",",5)=$S($P(X,U,4)]"":$P(X,U,4),1:"")
.. D ;SPELL CHECK 5.13 v STATE FILE'S COUNTY
... N DIERR,X1
... S X1=$$GET1^DIQ(5.01,CO_",",.01)
... I X1'=$P(X,U,2) S FDA(5.01,CO_","_ST_",",.01)=$P(X,U,2)
.. D FILE^DIE("","FDA","EM")
.. Q
. Q
I 'XIPQ D MES^XPDUTL("Finished updating COUNTY multiple.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXIPSYNC 1991 printed Dec 13, 2024@02:02:33 Page 2
XIPSYNC ;OIFOO/SO- SYNC UP FILE 5'S COUNTY MULTIPLE WITH 5.13;6:56 AM 16 Nov 2005
+1 ;;8.0;KERNEL;**328,378**;Jul 10, 1995;Build 59
+2 QUIT
EP1 ;MAIN ENTRY POINT
+1 ;ALLOW DIALOG TO DISPLAY OR PRINT
NEW XIPQ
SET XIPQ=0
+2 ;
+3 ;ALLOW EDITING ;8*378
NEW XUMF
SET XUMF=1
+4 ;
+5 DO S1
DO S2
+6 QUIT
+7 ;
DEQUE ;DEQUEUING ENTRY POINT
+1 ;KEEP DIALOG FROM DISPLAYING OR PRINTING
NEW XIPQ
SET XIPQ=1
+2 ;
+3 ;ALLOW EDITING ;8*378
NEW XUMF
SET XUMF=1
+4 ;
+5 DO S1
DO S2
+6 QUIT
+7 ;
S1 ;SET INACTIVE DATE FOR ALL COUNTIES TO DT
+1 NEW ST
+2 ;ST=STATE IEN
SET ST=0
+3 IF 'XIPQ
DO MES^XPDUTL("Begin updating COUNTY multiple...")
+4 FOR
SET ST=$ORDER(^DIC(5,ST))
if 'ST
QUIT
Begin DoDot:1
+5 ;NOT US STATE OR PR
IF +$PIECE(^DIC(5,ST,0),U,3)>56
IF +$PIECE(^(0),U,3)'=72
QUIT
+6 ;CO=COUNTY IEN
NEW CO
SET CO=0
+7 FOR
SET CO=$ORDER(^DIC(5,ST,1,CO))
if 'CO
QUIT
Begin DoDot:2
+8 ;DON'T CHANGE DATE
IF $PIECE(^DIC(5,ST,1,CO,0),U,5)]""
QUIT
+9 NEW FDA,DIERR,EM
+10 SET FDA(5.01,CO_","_ST_",",5)=DT
+11 DO FILE^DIE("","FDA","EM")
+12 QUIT
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
S2 ;EDIT COUNTY MULTIPLE USING FILE 5.13
+1 NEW IEN,X,FST,FCO
+2 ;FST=2 DIGIT STATE FIPS CODE, FCO=3 DIGIT COUNTY FIPS CODE
+3 ;5.13'S IEN
SET IEN=0
+4 FOR
SET IEN=$ORDER(^XIP(5.13,IEN))
if 'IEN
QUIT
SET X=^XIP(5.13,IEN,0)
SET FST=$EXTRACT(X,1,2)
SET FCO=$EXTRACT(X,3,5)
Begin DoDot:1
+5 NEW ST,CO
+6 SET ST=0
SET CO=0
+7 SET ST=$ORDER(^DIC(5,"C",FST,ST))
+8 IF 'ST
IF 'XIPQ
DO MES^XPDUTL("Can not find STATE CODE: "_FST_" in STATE file.")
QUIT
+9 SET CO=$ORDER(^DIC(5,ST,1,"C",FCO,CO))
+10 ;ADD COUNTY
IF 'CO
Begin DoDot:2
+11 NEW DIERR,EM,FDA
+12 IF 'XIPQ
DO MES^XPDUTL("Adding County: "_$PIECE(X,U,2)_"("_FCO_")"_" to State: "_$$GET1^DIQ(5,ST_",",.01))
+13 SET FDA(5.01,"?+1,"_ST_",",.01)=$PIECE(X,U,2)
+14 SET FDA(5.01,"?+1,"_ST_",",2)=FCO
+15 DO UPDATE^DIE("","FDA","","EM")
+16 QUIT
End DoDot:2
QUIT
+17 ;REACTIVATE COUNTY
IF CO
Begin DoDot:2
+18 NEW DIERR,EM,FDA
+19 SET FDA(5.01,CO_","_ST_",",5)=$SELECT($PIECE(X,U,4)]"":$PIECE(X,U,4),1:"")
+20 ;SPELL CHECK 5.13 v STATE FILE'S COUNTY
Begin DoDot:3
+21 NEW DIERR,X1
+22 SET X1=$$GET1^DIQ(5.01,CO_",",.01)
+23 IF X1'=$PIECE(X,U,2)
SET FDA(5.01,CO_","_ST_",",.01)=$PIECE(X,U,2)
End DoDot:3
+24 DO FILE^DIE("","FDA","EM")
+25 QUIT
End DoDot:2
QUIT
+26 QUIT
End DoDot:1
+27 IF 'XIPQ
DO MES^XPDUTL("Finished updating COUNTY multiple.")
+28 QUIT
