Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFPD06

ACRFPD06.m

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