ACRFPD06 ;IHS/OIRM/DSD/AEF - UPDATE ARMS PER DIEM CITY FILE [ 9/30/2005 10:01 AM ]
;;2.1;ADMIN RESOURCE MGMT SYSTEM;**18**;JAN 01, 2003
;
; ROUTINE FOR PATCH ACR*2.1*18
;
; This routine will take the perdiem data from the temporary
; updates file and move it into the ARMS PER DIEM CITY file.
;
; This routine searches for missing STATE fields and Military
; installations and 'deactivates' the CITY field with "XX"
;
;
; The routine checks for and deletes old "D" cross-reference
; that points to cities that have been set to "XX"
;
EN ;EP -- MAIN ENTRY POINT
;
D ^XBKVAR
D MSG(3,">>>Installing ARMS patch ACR*2.1*18...")
H 2
N CNT,UPDATE
S UPDATE=3051001 ;CHANGE THIS EVERY YEAR
S INSTALL=DT
W !!,"BEGINNING CLEAN UP OF MISSING STATE/MILLITARY INSTALLATION ENTRIES" H 3
D LOOP1 ;CLEAN OUT MISSING STATES & MILITARY
; NOW BEGIN UPDATES
W !!,"BEGINNING UPDATES"
D BLD
D UPDATE
W !!,"BEGINNING CROSS-REFERENCES CLEAN UP" H 2
D MULT ;CLEAN OUT IDENTICAL ENTRIES
D CLEAN ;CLEAN "D" X-REF
D CLEANB ;CLEAN "B" X-REF
D CLEANC ;CLEAN "C" X-REF
D CLEANX ;CLEAN INTERNAL "B" X-REF
K ^TMP("ACRZ",$J,"CITY")
K ^TMP("ACRZ",$J,"ADDCITY")
K ^TMP("ACRZ",$J,"UPDATE")
D MSG(3,CNT_" CITIES UPDATED")
;D DELETE ;COMMENT OUT/IN FOR TESTING
K ^ACRZPDC(9002199.9) ;COMMENT OUT/IN FOR TESTING
D MSG(3,"DONE!")
Q
;
LOOP1 ;----- BUILD GLOBAL CONTAINING CITY DATA FOR BAD DATA CLEANUP
;
K ^TMP("ACRZ",$J)
N CITY,DATA,IEN,STATE
S IEN=0
F S IEN=$O(^ACRPD(IEN)) Q:'IEN D
. S DATA=$G(^ACRPD(IEN,0))
. Q:DATA=""
. S CITY=$P(DATA,U)
. Q:CITY=""
. I $E(CITY,1,2)="XX" D Q
. .K ^ACRPD(IEN,1) ;REMOVE MULTIPLE CITY NODES
. S STATE=$P(DATA,U,2)
. I $$MIL(CITY) D Q
. .S ^TMP("ACRZ",$J,"CITY",CITY,IEN)=""
. .D DEACT(CITY,IEN)
. I STATE="" D ;ONLY WANT MISSING STATES
. .S ^TMP("ACRZ",$J,"CITY",CITY,IEN)=""
. .D DEACT(CITY,IEN)
K ^TMP("ACRZ",$J)
Q
;
UPDATE ;----- BEGIN UPDATE PROCESS
;
N ACRZD0
S (ACRZD0,CNT)=0
F S ACRZD0=$O(^ACRZPDC(9002199.9,ACRZD0)) Q:'ACRZD0 D
. D UP(ACRZD0)
D LEFT
D LOOP
Q
;
UP(ACRZD0) ;----- UPDATE ONE ENTRY
;
N BEGIN,CITY,COUNTY,EFFECT,END,IEN,LODGE,MEALS,OLDIEN,STATE
D DATA(ACRZD0)
Q:CITY=""!(STATE="")
S (IEN,OLDIEN)=$O(^TMP("ACRZ",$J,"CITY",CITY_" "_STATE,0))
I 'IEN D ADD(.IEN,CITY,STATE)
Q:IEN'>0
D EDIT(IEN,CITY,STATE,LODGE,MEALS,EFFECT,BEGIN,END,COUNTY)
Q:IEN'=OLDIEN
K ^TMP("ACRZ",$J,"CITY",CITY_" "_STATE,IEN)
Q
;
EDIT(IEN,CITY,STATE,LODGE,MEALS,EFFECT,BEGIN,END,COUNTY) ;
;----- EDIT ARMS PER DIEM CITY ENTRY
;
N DA,DIE,DR,X,Y,STR
S CNT=$G(CNT)+1
I COUNTY="",$P(^ACRPD(IEN,0),U,8)]"" S COUNTY=$P(^ACRPD(IEN,0),U,8)
S DIE="^ACRPD("
S DA=IEN
S DR=".03///"_LODGE
S DR=DR_";.04///"_MEALS
S DR=DR_";.05///"_EFFECT
S DR=DR_";.06///"_BEGIN
S DR=DR_";.07///"_END
S DR=DR_";.08///"_COUNTY
S DR=DR_";99.1///"_UPDATE
S DR=DR_";99.2///"_INSTALL
D ^DIE
D OTH(IEN,CITY,STATE)
D MSG(1," - UPDATED")
Q
MSG(N,SUFX) ;LOCAL ENTRY
I N=3 D BMES^XPDUTL(SUFX) Q
S STR=IEN_" "_CITY_", "
I STATE]"" S STR=STR_$P($G(^DIC(5,STATE,0)),U)
I N=1 D
.S STR=STR_" "_$E(BEGIN,4,5)_"/"_$E(BEGIN,6,7)
.S STR=STR_"-"_$E(END,4,5)_"/"_$E(END,6,7)
D BMES^XPDUTL(STR_SUFX)
Q
;
OTH(IEN,CITY,STATE) ;----- ADD ADDITIONAL CITIES
;
N ADDCITY,DA,DD,DIC,DLAYGO,DO,X,Y
Q:'$D(^TMP("ACRZ",$J,"ADDCITY",CITY_" "_STATE))
S ADDCITY=""
F S ADDCITY=$O(^TMP("ACRZ",$J,"ADDCITY",CITY_" "_STATE,ADDCITY)) Q:ADDCITY']"" D
. Q:$D(^ACRPD(IEN,1,"B",ADDCITY))
. S DA(1)=IEN
. S DIC="^ACRPD("_DA(1)_","_1_","
. S DIC(0)="L"
. S DIC("P")=$P(^DD(9002199.9,1,0),U,2)
. S DLAYGO=9002199.91
. S X=ADDCITY
. K DD,DO
. D FILE^DICN
. I Y<0 D MSG(1," - NOT UPDATED")
Q
;
ADD(IEN,CITY,STATE) ;----- ADD NEW CITY TO ARMS PER DIEM CITY FILE
;
N DIC,DIADD,DLAYGO,X,Y
S DIC="^ACRPD("
S DIC(0)="L"
S DIC("DR")=".02////^S X=STATE"
S DLAYGO=9002193.9
S DIADD=1
S X=CITY
D ^DIC
I Y<0 S IEN=Y D MSG(2," - **NOT** ADDED") Q
S IEN=+Y
D MSG(2," - ADDED")
Q
;
LEFT ;----- PROCESS LEFTOVERS ("XX" DUPLICATES)
;
N CITY,IEN
S CITY=""
F S CITY=$O(^TMP("ACRZ",$J,"UPDATE",CITY)) Q:CITY']"" D
. S IEN=0
. F S IEN=$O(^TMP("ACRZ",$J,"CITY",CITY,IEN)) Q:'IEN D
. . D DEACT(CITY,IEN)
Q
;
DEACT(CITY,IEN) ;----- DEACTIVATE DUPLICATE CITY
;
N DA,DATA,DIE,DR,NAME,STATE
S DATA=$G(^ACRPD(IEN,0))
Q:DATA=""
S NAME=$P(DATA,U)
I $E(NAME,1,2)="XX" D Q ; ALREADY DEACTIVATED
.Q:'$D(^ACRPD(N,1))
.K ^ACRPD(N,1) W !,N,?7,NAME_" Node 1 KILLED"
S LOCAL=$P($G(^ACRPD(IEN,99)),U,3)
Q:LOCAL="Y" ; LOCAL CITY ENTRY, DO NOT DEACTIVATE
S NAME="XX"_$E(NAME,1,28)
S STATE=$P(DATA,U,2)
S DIE="^ACRPD("
S DA=IEN
S DR=".01///^S X=NAME;99.1///^S X=UPDATE;99.2////"_INSTALL
D ^DIE
I DA<0 D MSG(2," - **NOT** DEACTIVATED") Q
K ^ACRPD(IEN,1) ;REMOVE "B" MULTIPLE COMPLETELY
D MSG(2," - DEACTIVATED")
Q
;
DATA(ACRZD0) ;----- GATHER PER DIEM DATA FROM UPDATE FILE
;
N DATA
S DATA=$G(^ACRZPDC(9002199.9,ACRZD0,0))
S CITY=$P(DATA,U)
S STATE=$P(DATA,U,2)
S COUNTY=$P(DATA,U,8)
S BEGIN=$P(DATA,U,6)
S END=$P(DATA,U,7)
S LODGE=$P(DATA,U,3)
S MEALS=$P(DATA,U,4)
S EFFECT=$P(DATA,U,5)
Q
;
BLD ;----- BUILD ^TMP GLOBAL ARRAYS CONTAINING PER DIEM CITY DATA
;
D BLDC,BLDU
Q
;
BLDC ;----- BUILD GLOBAL CONTAINING CITY DATA
;
N CITY,DATA,IEN,STATE
K ^TMP("ACRZ",$J,"CITY")
K ^TMP("ACRZ",$J,"ADDCITY")
S IEN=0
F S IEN=$O(^ACRPD(IEN)) Q:'IEN D
. S DATA=$G(^ACRPD(IEN,0))
. Q:DATA=""
. S CITY=$P(DATA,U)
. Q:CITY=""
. S STATE=$P(DATA,U,2)
. Q:STATE=""
. S ^TMP("ACRZ",$J,"CITY",CITY_" "_STATE,IEN)=""
. D BLDA(IEN,CITY,STATE)
Q
;
BLDA(IEN,CITY,STATE) ;---- BUILD GLOBAL CONTAINING ADDITIONAL CITY DATA
;
N ADDCITY,D1
S D1=0
F S D1=$O(^ACRPD(IEN,1,D1)) Q:'D1 D
. S ADDCITY=$G(^ACRPD(IEN,1,D1,0))
. Q:ADDCITY=""
. I ADDCITY=CITY D Q
. .K ^ACRPD(IEN,1,D1,0)
. .K ^ACRPD(IEN,1,"B",ADDCITY)
. S ^TMP("ACRZ",$J,"ADDCITY",CITY_" "_STATE,ADDCITY)=""
Q
;
BLDU ;----- BUILD GLOBAL CONTAINING UPDATE DATA
;
N CITY,DATA,IEN,STATE
K ^TMP("ACRZ",$J,"UPDATE")
S IEN=0
F S IEN=$O(^ACRZPDC(9002199.9,IEN)) Q:'IEN D
. S DATA=$G(^ACRZPDC(9002199.9,IEN,0))
. Q:DATA=""
. S CITY=$P(DATA,U)
. Q:CITY=""
. S STATE=$P(DATA,U,2)
. Q:STATE=""
. S ^TMP("ACRZ",$J,"UPDATE",CITY_" "_STATE)=""
Q
;
DELETE ;----- DELETE ACRZ ARMS PER DIEM CITY UPDATE FILE
;
N DIU
S DIU="^ACRZPDC(9002199.9,"
S DIU(0)="DT"
D EN^DIU2
D MSG(3,"ACRZ PER DIEM CITY UPDATE file <DELETED>")
Q
;
LOOP ;-- LOOP THROUGH ALL CITIES NOT UPDATED AND SET TO STANDARD RATE
;
N DA,DATA,DIE,DR,LAST,LOCAL,OLDATE,PD,STATE
S PD=0
F S PD=$O(^ACRPD(PD)) Q:'PD D
. S DATA=^ACRPD(PD,0)
. Q:$E($P(DATA,U),1,2)="XX"
. S STATE=$P(DATA,U,2)
. S DATA=$G(^ACRPD(PD,99))
. S OLDATE=$P(DATA,U)
. Q:UPDATE=OLDATE
. S LOCAL=$P(DATA,U,3)
. I LOCAL="Y" S DR=""
. I LOCAL'="Y" D ;CHECK EVERY YEAR
..;I STATE=2 S DR=".03////80;.04////54" ;ALASKA STAND RATE FY03
.. I STATE=2 S DR=".03////80;.04////55" ;ALASKA STAND RATE FY04,FY05,FY06
..;I STATE'=2 S DR=".03////55;.04////30" ;CONUS STAND RATE FY03
.. I STATE=12 S DR=".03////72;.04////61" ;HAWAII STAND RATE FY04,FY05,FY06
.. I STATE'=2,STATE'=12 D
...;S DR=".03////55;.04////31" ;CONUS STAND RATE FY04
...;S DR=".03////60;.04////31" ;CONUS STAND RATE FY05
...S DR=".03////60;.04////39" ;CONUS STAND RATE FY06
. S DR=DR_";99.1///"_UPDATE
. S DR=DR_";99.2///"_INSTALL
. S DIE="^ACRPD("
. S DA=PD
. D ^DIE
Q
;
CLEAN ; CLEAN OUT OLD "D" CROSS-REFERENCES THAT POINT TO "XX" CITIES
N N,P,CITY
S N=0
F S N=$O(^ACRPD("D",N)) Q:N="" D
.S P=0 F S P=$O(^ACRPD("D",N,P)) Q:P="" D
..S CITY=$P($G(^ACRPD(P,0)),U)
..I $E(CITY,1,2)="XX"!($$MIL(CITY)) D
...K ^ACRPD("D",N,P)
Q
CLEANB ; CLEAN OUT OLD "B" CROSS-REFERENCES THAT POINT TO "XX" CITIES
N N,P,CITY
S N=0
F S N=$O(^ACRPD("B",N)) Q:N="" D
.S P=0 F S P=$O(^ACRPD("B",N,P)) Q:P="" D
..S CITY=$P($G(^ACRPD(P,0)),U)
..I $E(CITY,1,2)="XX"!($$MIL(CITY)) D
...K ^ACRPD("B",N,P)
Q
CLEANC ; CLEAN OUT OLD "C" CROSS-REFERENCES THAT POINT TO "XX" CITIES
N N,P,CITY
S N=0
F S N=$O(^ACRPD("C",N)) Q:N="" D
.S P=0 F S P=$O(^ACRPD("C",N,P)) Q:P="" D
..S CITY=$P($G(^ACRPD(P,0)),U)
..I $E(CITY,1,2)="XX"!($$MIL(CITY)) D
...K ^ACRPD("C",N,P)
Q
CLEANX ; CLEAN OUT OLD INTERNAL "B" CROSS-REFERENCES THAT ARE NOT IN "B" X-REF
N N,P,Q,CITY
S N=0
F S N=$O(^ACRPD(N)) Q:N="" D
.Q:'$D(^ACRPD(N,1))
.S P=0
.F S P=$O(^ACRPD(N,1,P)) Q:P="" D
..S CITY=$G(^ACRPD(N,1,P,0))
..S Q=""
..F S Q=$O(^ACRPD(N,1,P,Q)) Q:Q="" D
...I CITY]"",$E(^ACRPD(N,0),1,2)="XX"!($$MIL(CITY)) D
....K ^ACRPD(N,1,"B",CITY)
....K ^ACRPD(N,1,P)
Q
MIL(CITY) ;EXTRINSIC FUNCTION TO DETERMINE IF MILITARY ENTRY
I $E(CITY,1,2)="XX" Q 0
I CITY["[INCL "!(CITY["(INCL ") Q 0
I CITY="ANCHORAGE" Q 1 ;TMP FIX REMOVE NEXT YEAR (2006)
I CITY["NAVAL "!(CITY["ARMY ")!(CITY["NAVY ")!(CITY["USMC") Q 1
I CITY["AIR FORCE"!(CITY[" AFB")!(CITY[" CG ")!(CITY["COAST GUAR") Q 1
I CITY["SOLDIER'S H"!(CITY[" NS")!(CITY[" RES RC") Q 1
I CITY["CTR"!(CITY["MC RES")!(CITY[" AGS")!(CITY["PROVING GR") Q 1
I CITY["MC LOGIS"!(CITY[" CMD")!(CITY[" CRTC") Q 1
I CITY["NAV NUC"!(CITY["SHIPBUILD")!(CITY["AIR TERM") Q 1
I CITY[" RES C"!(CITY[" FLT ")!(CITY[" DEPOT")!(CITY["CAMP ") Q 1
I CITY[" NAS" Q 1
Q 0
MULT ; LOOK AT IDENTICAL DUPLICATES
K ^TMP("ACRZ",$J,"DUPS")
N N,P,Q,DATA,CITY,STATE,CITST
S N=0
F S N=$O(^ACRPD(N)) Q:'N D
.S DATA=$G(^ACRPD(N,0))
.S CITY=$P(DATA,U)
.Q:$E(CITY,1,2)="XX"
.S STATE=$P(DATA,U,2)
.S CITST=CITY_" "_STATE
.I $G(^TMP("ACRZ",$J,"DUPS",CITST))=DATA D Q
..D DEACT(CITY,N)
.S ^TMP("ACRZ",$J,"DUPS",CITST)=DATA
Q
ACRFPD06 ;IHS/OIRM/DSD/AEF - UPDATE ARMS PER DIEM CITY FILE [ 9/30/2005 10:01 AM ]
+1 ;;2.1;ADMIN RESOURCE MGMT SYSTEM;**18**;JAN 01, 2003
+2 ;
+3 ; ROUTINE FOR PATCH ACR*2.1*18
+4 ;
+5 ; This routine will take the perdiem data from the temporary
+6 ; updates file and move it into the ARMS PER DIEM CITY file.
+7 ;
+8 ; This routine searches for missing STATE fields and Military
+9 ; installations and 'deactivates' the CITY field with "XX"
+10 ;
+11 ;
+12 ; The routine checks for and deletes old "D" cross-reference
+13 ; that points to cities that have been set to "XX"
+14 ;
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 DO ^XBKVAR
+3 DO MSG(3,">>>Installing ARMS patch ACR*2.1*18...")
+4 HANG 2
+5 NEW CNT,UPDATE
+6 ;CHANGE THIS EVERY YEAR
SET UPDATE=3051001
+7 SET INSTALL=DT
+8 WRITE !!,"BEGINNING CLEAN UP OF MISSING STATE/MILLITARY INSTALLATION ENTRIES"
HANG 3
+9 ;CLEAN OUT MISSING STATES & MILITARY
DO LOOP1
+10 ; NOW BEGIN UPDATES
+11 WRITE !!,"BEGINNING UPDATES"
+12 DO BLD
+13 DO UPDATE
+14 WRITE !!,"BEGINNING CROSS-REFERENCES CLEAN UP"
HANG 2
+15 ;CLEAN OUT IDENTICAL ENTRIES
DO MULT
+16 ;CLEAN "D" X-REF
DO CLEAN
+17 ;CLEAN "B" X-REF
DO CLEANB
+18 ;CLEAN "C" X-REF
DO CLEANC
+19 ;CLEAN INTERNAL "B" X-REF
DO CLEANX
+20 KILL ^TMP("ACRZ",$JOB,"CITY")
+21 KILL ^TMP("ACRZ",$JOB,"ADDCITY")
+22 KILL ^TMP("ACRZ",$JOB,"UPDATE")
+23 DO MSG(3,CNT_" CITIES UPDATED")
+24 ;D DELETE ;COMMENT OUT/IN FOR TESTING
+25 ;COMMENT OUT/IN FOR TESTING
KILL ^ACRZPDC(9002199.9)
+26 DO MSG(3,"DONE!")
+27 QUIT
+28 ;
LOOP1 ;----- BUILD GLOBAL CONTAINING CITY DATA FOR BAD DATA CLEANUP
+1 ;
+2 KILL ^TMP("ACRZ",$JOB)
+3 NEW CITY,DATA,IEN,STATE
+4 SET IEN=0
+5 FOR
SET IEN=$ORDER(^ACRPD(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+6 SET DATA=$GET(^ACRPD(IEN,0))
+7 IF DATA=""
QUIT
+8 SET CITY=$PIECE(DATA,U)
+9 IF CITY=""
QUIT
+10 IF $EXTRACT(CITY,1,2)="XX"
Begin DoDot:2
+11 ;REMOVE MULTIPLE CITY NODES
KILL ^ACRPD(IEN,1)
End DoDot:2
QUIT
+12 SET STATE=$PIECE(DATA,U,2)
+13 IF $$MIL(CITY)
Begin DoDot:2
+14 SET ^TMP("ACRZ",$JOB,"CITY",CITY,IEN)=""
+15 DO DEACT(CITY,IEN)
End DoDot:2
QUIT
+16 ;ONLY WANT MISSING STATES
IF STATE=""
Begin DoDot:2
+17 SET ^TMP("ACRZ",$JOB,"CITY",CITY,IEN)=""
+18 DO DEACT(CITY,IEN)
End DoDot:2
End DoDot:1
+19 KILL ^TMP("ACRZ",$JOB)
+20 QUIT
+21 ;
UPDATE ;----- BEGIN UPDATE PROCESS
+1 ;
+2 NEW ACRZD0
+3 SET (ACRZD0,CNT)=0
+4 FOR
SET ACRZD0=$ORDER(^ACRZPDC(9002199.9,ACRZD0))
IF 'ACRZD0
QUIT
Begin DoDot:1
+5 DO UP(ACRZD0)
End DoDot:1
+6 DO LEFT
+7 DO LOOP
+8 QUIT
+9 ;
UP(ACRZD0) ;----- UPDATE ONE ENTRY
+1 ;
+2 NEW BEGIN,CITY,COUNTY,EFFECT,END,IEN,LODGE,MEALS,OLDIEN,STATE
+3 DO DATA(ACRZD0)
+4 IF CITY=""!(STATE="")
QUIT
+5 SET (IEN,OLDIEN)=$ORDER(^TMP("ACRZ",$JOB,"CITY",CITY_" "_STATE,0))
+6 IF 'IEN
DO ADD(.IEN,CITY,STATE)
+7 IF IEN'>0
QUIT
+8 DO EDIT(IEN,CITY,STATE,LODGE,MEALS,EFFECT,BEGIN,END,COUNTY)
+9 IF IEN'=OLDIEN
QUIT
+10 KILL ^TMP("ACRZ",$JOB,"CITY",CITY_" "_STATE,IEN)
+11 QUIT
+12 ;
EDIT(IEN,CITY,STATE,LODGE,MEALS,EFFECT,BEGIN,END,COUNTY) ;
+1 ;----- EDIT ARMS PER DIEM CITY ENTRY
+2 ;
+3 NEW DA,DIE,DR,X,Y,STR
+4 SET CNT=$GET(CNT)+1
+5 IF COUNTY=""
IF $PIECE(^ACRPD(IEN,0),U,8)]""
SET COUNTY=$PIECE(^ACRPD(IEN,0),U,8)
+6 SET DIE="^ACRPD("
+7 SET DA=IEN
+8 SET DR=".03///"_LODGE
+9 SET DR=DR_";.04///"_MEALS
+10 SET DR=DR_";.05///"_EFFECT
+11 SET DR=DR_";.06///"_BEGIN
+12 SET DR=DR_";.07///"_END
+13 SET DR=DR_";.08///"_COUNTY
+14 SET DR=DR_";99.1///"_UPDATE
+15 SET DR=DR_";99.2///"_INSTALL
+16 DO ^DIE
+17 DO OTH(IEN,CITY,STATE)
+18 DO MSG(1," - UPDATED")
+19 QUIT
MSG(N,SUFX) ;LOCAL ENTRY
+1 IF N=3
DO BMES^XPDUTL(SUFX)
QUIT
+2 SET STR=IEN_" "_CITY_", "
+3 IF STATE]""
SET STR=STR_$PIECE($GET(^DIC(5,STATE,0)),U)
+4 IF N=1
Begin DoDot:1
+5 SET STR=STR_" "_$EXTRACT(BEGIN,4,5)_"/"_$EXTRACT(BEGIN,6,7)
+6 SET STR=STR_"-"_$EXTRACT(END,4,5)_"/"_$EXTRACT(END,6,7)
End DoDot:1
+7 DO BMES^XPDUTL(STR_SUFX)
+8 QUIT
+9 ;
OTH(IEN,CITY,STATE) ;----- ADD ADDITIONAL CITIES
+1 ;
+2 NEW ADDCITY,DA,DD,DIC,DLAYGO,DO,X,Y
+3 IF '$DATA(^TMP("ACRZ",$JOB,"ADDCITY",CITY_" "_STATE))
QUIT
+4 SET ADDCITY=""
+5 FOR
SET ADDCITY=$ORDER(^TMP("ACRZ",$JOB,"ADDCITY",CITY_" "_STATE,ADDCITY))
IF ADDCITY']""
QUIT
Begin DoDot:1
+6 IF $DATA(^ACRPD(IEN,1,"B",ADDCITY))
QUIT
+7 SET DA(1)=IEN
+8 SET DIC="^ACRPD("_DA(1)_","_1_","
+9 SET DIC(0)="L"
+10 SET DIC("P")=$PIECE(^DD(9002199.9,1,0),U,2)
+11 SET DLAYGO=9002199.91
+12 SET X=ADDCITY
+13 KILL DD,DO
+14 DO FILE^DICN
+15 IF Y<0
DO MSG(1," - NOT UPDATED")
End DoDot:1
+16 QUIT
+17 ;
ADD(IEN,CITY,STATE) ;----- ADD NEW CITY TO ARMS PER DIEM CITY FILE
+1 ;
+2 NEW DIC,DIADD,DLAYGO,X,Y
+3 SET DIC="^ACRPD("
+4 SET DIC(0)="L"
+5 SET DIC("DR")=".02////^S X=STATE"
+6 SET DLAYGO=9002193.9
+7 SET DIADD=1
+8 SET X=CITY
+9 DO ^DIC
+10 IF Y<0
SET IEN=Y
DO MSG(2," - **NOT** ADDED")
QUIT
+11 SET IEN=+Y
+12 DO MSG(2," - ADDED")
+13 QUIT
+14 ;
LEFT ;----- PROCESS LEFTOVERS ("XX" DUPLICATES)
+1 ;
+2 NEW CITY,IEN
+3 SET CITY=""
+4 FOR
SET CITY=$ORDER(^TMP("ACRZ",$JOB,"UPDATE",CITY))
IF CITY']""
QUIT
Begin DoDot:1
+5 SET IEN=0
+6 FOR
SET IEN=$ORDER(^TMP("ACRZ",$JOB,"CITY",CITY,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+7 DO DEACT(CITY,IEN)
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
DEACT(CITY,IEN) ;----- DEACTIVATE DUPLICATE CITY
+1 ;
+2 NEW DA,DATA,DIE,DR,NAME,STATE
+3 SET DATA=$GET(^ACRPD(IEN,0))
+4 IF DATA=""
QUIT
+5 SET NAME=$PIECE(DATA,U)
+6 ; ALREADY DEACTIVATED
IF $EXTRACT(NAME,1,2)="XX"
Begin DoDot:1
+7 IF '$DATA(^ACRPD(N,1))
QUIT
+8 KILL ^ACRPD(N,1)
WRITE !,N,?7,NAME_" Node 1 KILLED"
End DoDot:1
QUIT
+9 SET LOCAL=$PIECE($GET(^ACRPD(IEN,99)),U,3)
+10 ; LOCAL CITY ENTRY, DO NOT DEACTIVATE
IF LOCAL="Y"
QUIT
+11 SET NAME="XX"_$EXTRACT(NAME,1,28)
+12 SET STATE=$PIECE(DATA,U,2)
+13 SET DIE="^ACRPD("
+14 SET DA=IEN
+15 SET DR=".01///^S X=NAME;99.1///^S X=UPDATE;99.2////"_INSTALL
+16 DO ^DIE
+17 IF DA<0
DO MSG(2," - **NOT** DEACTIVATED")
QUIT
+18 ;REMOVE "B" MULTIPLE COMPLETELY
KILL ^ACRPD(IEN,1)
+19 DO MSG(2," - DEACTIVATED")
+20 QUIT
+21 ;
DATA(ACRZD0) ;----- GATHER PER DIEM DATA FROM UPDATE FILE
+1 ;
+2 NEW DATA
+3 SET DATA=$GET(^ACRZPDC(9002199.9,ACRZD0,0))
+4 SET CITY=$PIECE(DATA,U)
+5 SET STATE=$PIECE(DATA,U,2)
+6 SET COUNTY=$PIECE(DATA,U,8)
+7 SET BEGIN=$PIECE(DATA,U,6)
+8 SET END=$PIECE(DATA,U,7)
+9 SET LODGE=$PIECE(DATA,U,3)
+10 SET MEALS=$PIECE(DATA,U,4)
+11 SET EFFECT=$PIECE(DATA,U,5)
+12 QUIT
+13 ;
BLD ;----- BUILD ^TMP GLOBAL ARRAYS CONTAINING PER DIEM CITY DATA
+1 ;
+2 DO BLDC
DO BLDU
+3 QUIT
+4 ;
BLDC ;----- BUILD GLOBAL CONTAINING CITY DATA
+1 ;
+2 NEW CITY,DATA,IEN,STATE
+3 KILL ^TMP("ACRZ",$JOB,"CITY")
+4 KILL ^TMP("ACRZ",$JOB,"ADDCITY")
+5 SET IEN=0
+6 FOR
SET IEN=$ORDER(^ACRPD(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+7 SET DATA=$GET(^ACRPD(IEN,0))
+8 IF DATA=""
QUIT
+9 SET CITY=$PIECE(DATA,U)
+10 IF CITY=""
QUIT
+11 SET STATE=$PIECE(DATA,U,2)
+12 IF STATE=""
QUIT
+13 SET ^TMP("ACRZ",$JOB,"CITY",CITY_" "_STATE,IEN)=""
+14 DO BLDA(IEN,CITY,STATE)
End DoDot:1
+15 QUIT
+16 ;
BLDA(IEN,CITY,STATE) ;---- BUILD GLOBAL CONTAINING ADDITIONAL CITY DATA
+1 ;
+2 NEW ADDCITY,D1
+3 SET D1=0
+4 FOR
SET D1=$ORDER(^ACRPD(IEN,1,D1))
IF 'D1
QUIT
Begin DoDot:1
+5 SET ADDCITY=$GET(^ACRPD(IEN,1,D1,0))
+6 IF ADDCITY=""
QUIT
+7 IF ADDCITY=CITY
Begin DoDot:2
+8 KILL ^ACRPD(IEN,1,D1,0)
+9 KILL ^ACRPD(IEN,1,"B",ADDCITY)
End DoDot:2
QUIT
+10 SET ^TMP("ACRZ",$JOB,"ADDCITY",CITY_" "_STATE,ADDCITY)=""
End DoDot:1
+11 QUIT
+12 ;
BLDU ;----- BUILD GLOBAL CONTAINING UPDATE DATA
+1 ;
+2 NEW CITY,DATA,IEN,STATE
+3 KILL ^TMP("ACRZ",$JOB,"UPDATE")
+4 SET IEN=0
+5 FOR
SET IEN=$ORDER(^ACRZPDC(9002199.9,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+6 SET DATA=$GET(^ACRZPDC(9002199.9,IEN,0))
+7 IF DATA=""
QUIT
+8 SET CITY=$PIECE(DATA,U)
+9 IF CITY=""
QUIT
+10 SET STATE=$PIECE(DATA,U,2)
+11 IF STATE=""
QUIT
+12 SET ^TMP("ACRZ",$JOB,"UPDATE",CITY_" "_STATE)=""
End DoDot:1
+13 QUIT
+14 ;
DELETE ;----- DELETE ACRZ ARMS PER DIEM CITY UPDATE FILE
+1 ;
+2 NEW DIU
+3 SET DIU="^ACRZPDC(9002199.9,"
+4 SET DIU(0)="DT"
+5 DO EN^DIU2
+6 DO MSG(3,"ACRZ PER DIEM CITY UPDATE file <DELETED>")
+7 QUIT
+8 ;
LOOP ;-- LOOP THROUGH ALL CITIES NOT UPDATED AND SET TO STANDARD RATE
+1 ;
+2 NEW DA,DATA,DIE,DR,LAST,LOCAL,OLDATE,PD,STATE
+3 SET PD=0
+4 FOR
SET PD=$ORDER(^ACRPD(PD))
IF 'PD
QUIT
Begin DoDot:1
+5 SET DATA=^ACRPD(PD,0)
+6 IF $EXTRACT($PIECE(DATA,U),1,2)="XX"
QUIT
+7 SET STATE=$PIECE(DATA,U,2)
+8 SET DATA=$GET(^ACRPD(PD,99))
+9 SET OLDATE=$PIECE(DATA,U)
+10 IF UPDATE=OLDATE
QUIT
+11 SET LOCAL=$PIECE(DATA,U,3)
+12 IF LOCAL="Y"
SET DR=""
+13 ;CHECK EVERY YEAR
IF LOCAL'="Y"
Begin DoDot:2
+14 ;I STATE=2 S DR=".03////80;.04////54" ;ALASKA STAND RATE FY03
+15 ;ALASKA STAND RATE FY04,FY05,FY06
IF STATE=2
SET DR=".03////80;.04////55"
+16 ;I STATE'=2 S DR=".03////55;.04////30" ;CONUS STAND RATE FY03
+17 ;HAWAII STAND RATE FY04,FY05,FY06
IF STATE=12
SET DR=".03////72;.04////61"
+18 IF STATE'=2
IF STATE'=12
Begin DoDot:3
+19 ;S DR=".03////55;.04////31" ;CONUS STAND RATE FY04
+20 ;S DR=".03////60;.04////31" ;CONUS STAND RATE FY05
+21 ;CONUS STAND RATE FY06
SET DR=".03////60;.04////39"
End DoDot:3
End DoDot:2
+22 SET DR=DR_";99.1///"_UPDATE
+23 SET DR=DR_";99.2///"_INSTALL
+24 SET DIE="^ACRPD("
+25 SET DA=PD
+26 DO ^DIE
End DoDot:1
+27 QUIT
+28 ;
CLEAN ; CLEAN OUT OLD "D" CROSS-REFERENCES THAT POINT TO "XX" CITIES
+1 NEW N,P,CITY
+2 SET N=0
+3 FOR
SET N=$ORDER(^ACRPD("D",N))
IF N=""
QUIT
Begin DoDot:1
+4 SET P=0
FOR
SET P=$ORDER(^ACRPD("D",N,P))
IF P=""
QUIT
Begin DoDot:2
+5 SET CITY=$PIECE($GET(^ACRPD(P,0)),U)
+6 IF $EXTRACT(CITY,1,2)="XX"!($$MIL(CITY))
Begin DoDot:3
+7 KILL ^ACRPD("D",N,P)
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
CLEANB ; CLEAN OUT OLD "B" CROSS-REFERENCES THAT POINT TO "XX" CITIES
+1 NEW N,P,CITY
+2 SET N=0
+3 FOR
SET N=$ORDER(^ACRPD("B",N))
IF N=""
QUIT
Begin DoDot:1
+4 SET P=0
FOR
SET P=$ORDER(^ACRPD("B",N,P))
IF P=""
QUIT
Begin DoDot:2
+5 SET CITY=$PIECE($GET(^ACRPD(P,0)),U)
+6 IF $EXTRACT(CITY,1,2)="XX"!($$MIL(CITY))
Begin DoDot:3
+7 KILL ^ACRPD("B",N,P)
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
CLEANC ; CLEAN OUT OLD "C" CROSS-REFERENCES THAT POINT TO "XX" CITIES
+1 NEW N,P,CITY
+2 SET N=0
+3 FOR
SET N=$ORDER(^ACRPD("C",N))
IF N=""
QUIT
Begin DoDot:1
+4 SET P=0
FOR
SET P=$ORDER(^ACRPD("C",N,P))
IF P=""
QUIT
Begin DoDot:2
+5 SET CITY=$PIECE($GET(^ACRPD(P,0)),U)
+6 IF $EXTRACT(CITY,1,2)="XX"!($$MIL(CITY))
Begin DoDot:3
+7 KILL ^ACRPD("C",N,P)
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
CLEANX ; CLEAN OUT OLD INTERNAL "B" CROSS-REFERENCES THAT ARE NOT IN "B" X-REF
+1 NEW N,P,Q,CITY
+2 SET N=0
+3 FOR
SET N=$ORDER(^ACRPD(N))
IF N=""
QUIT
Begin DoDot:1
+4 IF '$DATA(^ACRPD(N,1))
QUIT
+5 SET P=0
+6 FOR
SET P=$ORDER(^ACRPD(N,1,P))
IF P=""
QUIT
Begin DoDot:2
+7 SET CITY=$GET(^ACRPD(N,1,P,0))
+8 SET Q=""
+9 FOR
SET Q=$ORDER(^ACRPD(N,1,P,Q))
IF Q=""
QUIT
Begin DoDot:3
+10 IF CITY]""
IF $EXTRACT(^ACRPD(N,0),1,2)="XX"!($$MIL(CITY))
Begin DoDot:4
+11 KILL ^ACRPD(N,1,"B",CITY)
+12 KILL ^ACRPD(N,1,P)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
MIL(CITY) ;EXTRINSIC FUNCTION TO DETERMINE IF MILITARY ENTRY
+1 IF $EXTRACT(CITY,1,2)="XX"
QUIT 0
+2 IF CITY["[INCL "!(CITY["(INCL ")
QUIT 0
+3 ;TMP FIX REMOVE NEXT YEAR (2006)
IF CITY="ANCHORAGE"
QUIT 1
+4 IF CITY["NAVAL "!(CITY["ARMY ")!(CITY["NAVY ")!(CITY["USMC")
QUIT 1
+5 IF CITY["AIR FORCE"!(CITY[" AFB")!(CITY[" CG ")!(CITY["COAST GUAR")
QUIT 1
+6 IF CITY["SOLDIER'S H"!(CITY[" NS")!(CITY[" RES RC")
QUIT 1
+7 IF CITY["CTR"!(CITY["MC RES")!(CITY[" AGS")!(CITY["PROVING GR")
QUIT 1
+8 IF CITY["MC LOGIS"!(CITY[" CMD")!(CITY[" CRTC")
QUIT 1
+9 IF CITY["NAV NUC"!(CITY["SHIPBUILD")!(CITY["AIR TERM")
QUIT 1
+10 IF CITY[" RES C"!(CITY[" FLT ")!(CITY[" DEPOT")!(CITY["CAMP ")
QUIT 1
+11 IF CITY[" NAS"
QUIT 1
+12 QUIT 0
MULT ; LOOK AT IDENTICAL DUPLICATES
+1 KILL ^TMP("ACRZ",$JOB,"DUPS")
+2 NEW N,P,Q,DATA,CITY,STATE,CITST
+3 SET N=0
+4 FOR
SET N=$ORDER(^ACRPD(N))
IF 'N
QUIT
Begin DoDot:1
+5 SET DATA=$GET(^ACRPD(N,0))
+6 SET CITY=$PIECE(DATA,U)
+7 IF $EXTRACT(CITY,1,2)="XX"
QUIT
+8 SET STATE=$PIECE(DATA,U,2)
+9 SET CITST=CITY_" "_STATE
+10 IF $GET(^TMP("ACRZ",$JOB,"DUPS",CITST))=DATA
Begin DoDot:2
+11 DO DEACT(CITY,N)
End DoDot:2
QUIT
+12 SET ^TMP("ACRZ",$JOB,"DUPS",CITST)=DATA
End DoDot:1
+13 QUIT
