ACRZPD4 ;IHS/OIRM/DSD/AEF - UPDATE ARMS PER DIEM CITY FILE [ 09/26/2002 10:19 AM ]
;;2.1;ADMIN RESOURCE MGMT SYSTEM;**4**;JAN 01, 2000
;
; ROUTINE FOR PATCH ACR*2.1*4
;
; This routine will take the perdiem data from the temporary
; updates file and move it into the ARMS PER DIEM CITY file.
;
; 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
;
N CNT,INSTALL,UPDATE
S UPDATE=3021001 ;CHANGE THIS EVERY YEAR
S INSTALL=DT
D ^XBKVAR
D MSG(3,">>>Installing ARMS patch ACR*2.1*4...")
H 2
D BLD
D UPDATE
D CLEAN
K ^TMP("ACRZ",$J,"CITY")
K ^TMP("ACRZ",$J,"ADDCITY")
K ^TMP("ACRZ",$J,"UPDATE")
D MSG(3,CNT_" CITIES UPDATED")
D DELETE
D MSG(3,"DONE!")
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(UPDATE,INSTALL)
D LOOP(UPDATE,INSTALL)
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)
D EDIT(IEN,CITY,STATE,LODGE,MEALS,EFFECT,BEGIN,END,COUNTY,UPDATE)
Q:IEN'=OLDIEN
K ^TMP("ACRZ",$J,"CITY",CITY_" "_STATE,IEN)
Q
;
EDIT(IEN,CITY,STATE,LODGE,MEALS,EFFECT,BEGIN,END,COUNTY,UPDATE) ;
;----- 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///^S X=LODGE"
S DR=DR_";.04///^S X=MEALS"
S DR=DR_";.05///^S X=EFFECT"
S DR=DR_";.06///^S X=BEGIN"
S DR=DR_";.07///^S X=END"
S DR=DR_";.08///^S X=COUNTY"
S DR=DR_";99.1///^S X=UPDATE"
S DR=DR_";99.2///^S X=INSTALL"
S DR=DR_";99.3///^S X=""N""" ; New field for local entry flag
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_", "_$P($G(^DIC(5,STATE,0)),U)
I N=1 D
.S STR=STR_" "_$E(BEGIN,1,2)_"/"_$E(BEGIN,3,4)
.S STR=STR_"-"_$E(END,1,2)_"/"_$E(END,3,4)
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")=".04////^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(UPDATE,INSTALL) ;----- 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,UPDATE,INSTALL)
Q
;
DEACT(CITY,IEN,UPDATE,INSTALL) ;----- DEACTIVATE DUPLICATE CITY
;
N DA,DATA,DIE,DR,NAME,STATE
S DATA=$G(^ACRPD(IEN,0))
Q:DATA=""
S NAME=$P(DATA,U)
Q:$E(NAME,1,2)="XX" ; ALREADY DEACTIVATED
S LOCAL=$P($G(^ACRPD(IEN,99)),U,3)
Q:LOCAL="Y" ; LOCAL CITY ENTRY, DO NOT DEACTIVATE
S NAME="XX"_NAME
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////^S X=INSTALL"
D ^DIE
I DA<0 D MSG(2," - **NOT** DEACTIVATED") Q
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 BEGIN=$E(BEGIN,4,7)
I BEGIN="" S BEGIN="0101"
S END=$P(DATA,U,7)
S END=$E(END,4,7)
I END="" S END=1231
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=""
. 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 ARMS PER DIEM CITY UPDATE file <DELETED>")
Q
;
LOOP(UPDATE,INSTALL) ;-- 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
.. I STATE=2 S DR=".03////80;.04////54" ;ALASKA STANDARD RATE
.. I STATE'=2 S DR=".03////55;.04////30" ;CONUS STANDARD RATE
. S DR=DR_";99.1///^S X=UPDATE;99.2///^S X=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,DATA
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 DATA=$G(^ACRPD(P,0))
..Q:$E(DATA,1,2)'="XX"
..K ^ACRPD("D",N,P)
Q
ACRZPD4 ;IHS/OIRM/DSD/AEF - UPDATE ARMS PER DIEM CITY FILE [ 09/26/2002 10:19 AM ]
+1 ;;2.1;ADMIN RESOURCE MGMT SYSTEM;**4**;JAN 01, 2000
+2 ;
+3 ; ROUTINE FOR PATCH ACR*2.1*4
+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 ; The routine checks for and deletes old "D" cross-reference
+9 ; that points to cities that have been set to "XX"
+10 ;
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 NEW CNT,INSTALL,UPDATE
+3 ;CHANGE THIS EVERY YEAR
SET UPDATE=3021001
+4 SET INSTALL=DT
+5 DO ^XBKVAR
+6 DO MSG(3,">>>Installing ARMS patch ACR*2.1*4...")
+7 HANG 2
+8 DO BLD
+9 DO UPDATE
+10 DO CLEAN
+11 KILL ^TMP("ACRZ",$JOB,"CITY")
+12 KILL ^TMP("ACRZ",$JOB,"ADDCITY")
+13 KILL ^TMP("ACRZ",$JOB,"UPDATE")
+14 DO MSG(3,CNT_" CITIES UPDATED")
+15 DO DELETE
+16 DO MSG(3,"DONE!")
+17 QUIT
+18 ;
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(UPDATE,INSTALL)
+7 DO LOOP(UPDATE,INSTALL)
+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 DO EDIT(IEN,CITY,STATE,LODGE,MEALS,EFFECT,BEGIN,END,COUNTY,UPDATE)
+8 IF IEN'=OLDIEN
QUIT
+9 KILL ^TMP("ACRZ",$JOB,"CITY",CITY_" "_STATE,IEN)
+10 QUIT
+11 ;
EDIT(IEN,CITY,STATE,LODGE,MEALS,EFFECT,BEGIN,END,COUNTY,UPDATE) ;
+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///^S X=LODGE"
+9 SET DR=DR_";.04///^S X=MEALS"
+10 SET DR=DR_";.05///^S X=EFFECT"
+11 SET DR=DR_";.06///^S X=BEGIN"
+12 SET DR=DR_";.07///^S X=END"
+13 SET DR=DR_";.08///^S X=COUNTY"
+14 SET DR=DR_";99.1///^S X=UPDATE"
+15 SET DR=DR_";99.2///^S X=INSTALL"
+16 ; New field for local entry flag
SET DR=DR_";99.3///^S X=""N"""
+17 DO ^DIE
+18 DO OTH(IEN,CITY,STATE)
+19 DO MSG(1," - UPDATED")
+20 QUIT
MSG(N,SUFX) ;LOCAL ENTRY
+1 IF N=3
DO BMES^XPDUTL(SUFX)
QUIT
+2 SET STR=IEN_" "_CITY_", "_$PIECE($GET(^DIC(5,STATE,0)),U)
+3 IF N=1
Begin DoDot:1
+4 SET STR=STR_" "_$EXTRACT(BEGIN,1,2)_"/"_$EXTRACT(BEGIN,3,4)
+5 SET STR=STR_"-"_$EXTRACT(END,1,2)_"/"_$EXTRACT(END,3,4)
End DoDot:1
+6 DO BMES^XPDUTL(STR_SUFX)
+7 QUIT
+8 ;
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")=".04////^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(UPDATE,INSTALL) ;----- 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,UPDATE,INSTALL)
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
DEACT(CITY,IEN,UPDATE,INSTALL) ;----- 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"
QUIT
+7 SET LOCAL=$PIECE($GET(^ACRPD(IEN,99)),U,3)
+8 ; LOCAL CITY ENTRY, DO NOT DEACTIVATE
IF LOCAL="Y"
QUIT
+9 SET NAME="XX"_NAME
+10 SET STATE=$PIECE(DATA,U,2)
+11 SET DIE="^ACRPD("
+12 SET DA=IEN
+13 SET DR=".01///^S X=NAME;99.1///^S X=UPDATE;99.2////^S X=INSTALL"
+14 DO ^DIE
+15 IF DA<0
DO MSG(2," - **NOT** DEACTIVATED")
QUIT
+16 DO MSG(2," - DEACTIVATED")
+17 QUIT
+18 ;
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 BEGIN=$EXTRACT(BEGIN,4,7)
+9 IF BEGIN=""
SET BEGIN="0101"
+10 SET END=$PIECE(DATA,U,7)
+11 SET END=$EXTRACT(END,4,7)
+12 IF END=""
SET END=1231
+13 SET LODGE=$PIECE(DATA,U,3)
+14 SET MEALS=$PIECE(DATA,U,4)
+15 SET EFFECT=$PIECE(DATA,U,5)
+16 QUIT
+17 ;
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 SET ^TMP("ACRZ",$JOB,"ADDCITY",CITY_" "_STATE,ADDCITY)=""
End DoDot:1
+8 QUIT
+9 ;
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 ARMS PER DIEM CITY UPDATE file <DELETED>")
+7 QUIT
+8 ;
LOOP(UPDATE,INSTALL) ;-- 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 IF LOCAL'="Y"
Begin DoDot:2
+14 ;ALASKA STANDARD RATE
IF STATE=2
SET DR=".03////80;.04////54"
+15 ;CONUS STANDARD RATE
IF STATE'=2
SET DR=".03////55;.04////30"
End DoDot:2
+16 SET DR=DR_";99.1///^S X=UPDATE;99.2///^S X=INSTALL"
+17 SET DIE="^ACRPD("
+18 SET DA=PD
+19 DO ^DIE
End DoDot:1
+20 QUIT
+21 ;
CLEAN ; CLEAN OUT OLD "D" CROSS-REFERENCES THAT POINT TO "XX" CITIES
+1 NEW N,P,DATA
+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 DATA=$GET(^ACRPD(P,0))
+6 IF $EXTRACT(DATA,1,2)'="XX"
QUIT
+7 KILL ^ACRPD("D",N,P)
End DoDot:2
End DoDot:1
+8 QUIT
