ACRFPERD ;IHS/OIRM/DSD/THL,AEF - MANAGE UPDATE OF PER DIEM & LODGING RATES; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;THIS ROUTINE MANAGES THE IMPORT OF LODGING AND PER DIEM RATES FROM
;;THE ANNUAL GSA UPDATE
EN D EN1
EXIT K ACR,ACRQUIT,ACROUT,ACRCNTY,ACRCNTZ,ACREFFCT,ACRMIE
D CLOSE^ACRFZIS
Q
EN1 ;
S ACREFFCT=2960301
D IMPORT
Q
IMPORT ;READ GSA FILE AND IMPORT NEW LODGING AND PER DIEM RATES
D OPEN
Q:$D(ACRQUIT)!$D(ACROUT)!$G(POP)
READ ;READ INDIVIDUAL RECORDS FROM THE GSA FILE
F U IO R ACRX:0 Q:ACRX="^^^^^" D:ACRX]"" SET ;DIRECT READ FROM UNIX FILE
Q
SET ;SET FIELDS FROM GSA RECORD
D ACRX
Q:ACRX=""!(ACRX=U)
D UPPER
I $D(^DIC(5,"B",$P(ACRX,U))) D Q
.S ACRSTATE=$P(ACRX,U)
.S ACRSTDA=$O(^DIC(5,"B",ACRSTATE,0))
S ACRPD=$P(ACRX,U,3,99)
I $E(ACRPD)="(" D I 1
.S ACRPD(1)=$P(ACRPD,U,2,4)_U_$P(ACRPD,U)
.S ACRPD(2)=$P(ACRPD,U,6,8)_U_$P(ACRPD,U,5)
E D
.S ACRPD(1)=ACRPD
.S ACRPD(2)=""
F I=1,2 D
.S ACRLDG(I)=$P(ACRPD(I),U)
.S ACRMIE(I)=$P(ACRPD(I),U,2)
.S ACRBEGIN(I)=$P(ACRPD(I),U,4)
.D DATE
S ACRCITY=$P(ACRX,U)
S ACRCNTY=$P(ACRX,U,2)
F ACRI=1:1 S X=$P(ACRCNTY,",",ACRI) Q:X="" S:$E(X)=" " X=$E(X,2,99) S ACRCNTZ=X D FIND
Q
FIND ;FIND MATCH TO EXISTING ARMS ENTRY
I '$D(^ACRPD("B",ACRCNTZ))&'$D(^ACRPD("B",ACRCNTZ_" COUNTY")) D TEMP
D F1
D UPDATE
Q
UPDATE ;RESET NEW PER DIEM AND LODGING RATES
F ACRJ=1,2 D:$G(ACRPDDA(ACRJ))]""
.S (ACRPDDA,DA)=ACRPDDA(ACRJ)
.S DIE="^ACRPD("
.S DR=".03////"_ACRLDG(ACRJ)_";.04////"_ACRMIE(ACRJ)_";.05////"_ACREFFCT_";.06////"_ACRBEGIN(ACRJ)_";.07////"_ACREND(ACRJ)
.I ACRLDG(ACRJ)&ACRMIE(ACRJ) U 0 W "." D DIE^ACRFDIC
.D CITY
Q
F1 ;
K ACRPDDA
N I
S (ACRPDDA,I)=0
F S ACRPDDA=$O(^ACRPD("B",ACRCNTZ,ACRPDDA)) Q:'ACRPDDA I $D(^ACRPD(ACRPDDA,0)),$P(^(0),U,2)=ACRSTDA S I=I+1,ACRPDDA(I)=ACRPDDA
Q:ACRCNTZ["PARISH"
S (ACRPDDA,I)=0
F S ACRPDDA=$O(^ACRPD("B",ACRCNTZ_" COUNTY",ACRPDDA)) Q:'ACRPDDA I $D(^ACRPD(ACRPDDA,0)),$P(^(0),U,2)=ACRSTDA S I=I+1,ACRPDDA(I)=ACRPDDA
I ACRPD(2)]"",'$D(ACRPDDA(2)) D
.S ACRCNTZ=ACRCNTZ_$S(ACRCNTZ'["PARRISH":" COUNTY",1:"")_" 222"
.D TEMP
.Q:+$G(Y)<1
.S ACRPDDA(2)=+Y
.S ACRCNTZ=$P(ACRCNTZ," 222")
.S DA=+Y
.S DIE="^ACRPD("
.S DR=".01///"_ACRCNTZ
.U 0 W " ",ACRCNTZ," ",ACRPDDA(2),!
.D DIE^ACRFDIC
Q
TEMP ;TEMPORARILY FILE GSA CITIES/COUNTIES WHICH DON'T MATCH CURRENT ARMS
;LISTING
S X=ACRCNTZ
S DIC="^ACRPD("
S DIC(0)="L"
S DIC("DR")=".02////"_ACRSTDA
U 0 W !,"2ND VENDOR ADDED"
D FILE^ACRFDIC
Q
OPEN ;OPEN GSA FILE
S %FN="conus96.thl"
S ACROP="R"
D HOST^ACRFZIS
Q
UPPER ;CONVERT ALL LOWER CASE TO UPPER CASE ALPHAS
S ACRX=$TR(ACRX,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Q
ACRX ;CONVERT EACH LINE INTO '^' DELIMITED STRING
N J,X,Z
S Z=""
F J=1:1:100 S X=$P(ACRX," ",J) I X]"" S:$E(X)=" " X=$E(X,2,9999) S Z=$G(Z)_X_U
S ACRX=Z
Q
DATE ;EVALUATE GSA DATE AND CHANGE TO FM
N A,W,X,Y,Z
I ACRBEGIN(I)="" S ACREND(I)="" Q
S W=$P($P(ACRBEGIN(I),"-"),"(",2)
S X=$P($P(ACRBEGIN(I),"-",2),")")
S Y=+$P(W," ",2,99),Z=+$P(X," ",2,99)
S W=$P(W," "),X=$P(X," ")
S A="JANUARY1FEBRUARY2MARCH3APRIL4MAY5JUNE6JULY7AUGUST8SEPTEMBER9OCTOBER10NOVEMBER11DECEMBER12"
S W=+$P(A,W,2)
S X=+$P(A,X,2)
S ACRBEGIN(I)="296"_$S($L(W)=1:"0",1:"")_W_$S($L(Y)=1:"0",1:"")_Y
S ACREND(I)="296"_$S($L(X)=1:"0",1:"")_X_$S($L(Z)=1:"0",1:"")_Z
Q
CITY ;CHECK COUNTY FOR ASSOCIATED CITIES
F I=1:1 S X=$P(ACRCITY,"/",I) Q:X="" S:$E(X)=" " X=$E(X,2,999) D
.Q:$D(^ACRPD(ACRPDDA,1,"B",X))
.S DIC="^ACRPD("_ACRPDDA_",1,"
.S DIC(0)="L"
.S DA(1)=ACRPDDA
.S:'$D(^ACRPD(ACRPDDA,1,0)) ^ACRPD(ACRPDDA,1,0)="^9002193.91"
.D FILE^ACRFDIC
Q
ACRFPERD ;IHS/OIRM/DSD/THL,AEF - MANAGE UPDATE OF PER DIEM & LODGING RATES; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;THIS ROUTINE MANAGES THE IMPORT OF LODGING AND PER DIEM RATES FROM
+3 ;;THE ANNUAL GSA UPDATE
EN DO EN1
EXIT KILL ACR,ACRQUIT,ACROUT,ACRCNTY,ACRCNTZ,ACREFFCT,ACRMIE
+1 DO CLOSE^ACRFZIS
+2 QUIT
EN1 ;
+1 SET ACREFFCT=2960301
+2 DO IMPORT
+3 QUIT
IMPORT ;READ GSA FILE AND IMPORT NEW LODGING AND PER DIEM RATES
+1 DO OPEN
+2 IF $DATA(ACRQUIT)!$DATA(ACROUT)!$GET(POP)
QUIT
READ ;READ INDIVIDUAL RECORDS FROM THE GSA FILE
+1 ;DIRECT READ FROM UNIX FILE
FOR
USE IO
READ ACRX:0
IF ACRX="^^^^^"
QUIT
IF ACRX]""
DO SET
+2 QUIT
SET ;SET FIELDS FROM GSA RECORD
+1 DO ACRX
+2 IF ACRX=""!(ACRX=U)
QUIT
+3 DO UPPER
+4 IF $DATA(^DIC(5,"B",$PIECE(ACRX,U)))
Begin DoDot:1
+5 SET ACRSTATE=$PIECE(ACRX,U)
+6 SET ACRSTDA=$ORDER(^DIC(5,"B",ACRSTATE,0))
End DoDot:1
QUIT
+7 SET ACRPD=$PIECE(ACRX,U,3,99)
+8 IF $EXTRACT(ACRPD)="("
Begin DoDot:1
+9 SET ACRPD(1)=$PIECE(ACRPD,U,2,4)_U_$PIECE(ACRPD,U)
+10 SET ACRPD(2)=$PIECE(ACRPD,U,6,8)_U_$PIECE(ACRPD,U,5)
End DoDot:1
IF 1
+11 IF '$TEST
Begin DoDot:1
+12 SET ACRPD(1)=ACRPD
+13 SET ACRPD(2)=""
End DoDot:1
+14 FOR I=1,2
Begin DoDot:1
+15 SET ACRLDG(I)=$PIECE(ACRPD(I),U)
+16 SET ACRMIE(I)=$PIECE(ACRPD(I),U,2)
+17 SET ACRBEGIN(I)=$PIECE(ACRPD(I),U,4)
+18 DO DATE
End DoDot:1
+19 SET ACRCITY=$PIECE(ACRX,U)
+20 SET ACRCNTY=$PIECE(ACRX,U,2)
+21 FOR ACRI=1:1
SET X=$PIECE(ACRCNTY,",",ACRI)
IF X=""
QUIT
IF $EXTRACT(X)=" "
SET X=$EXTRACT(X,2,99)
SET ACRCNTZ=X
DO FIND
+22 QUIT
FIND ;FIND MATCH TO EXISTING ARMS ENTRY
+1 IF '$DATA(^ACRPD("B",ACRCNTZ))&'$DATA(^ACRPD("B",ACRCNTZ_" COUNTY"))
DO TEMP
+2 DO F1
+3 DO UPDATE
+4 QUIT
UPDATE ;RESET NEW PER DIEM AND LODGING RATES
+1 FOR ACRJ=1,2
IF $GET(ACRPDDA(ACRJ))]""
Begin DoDot:1
+2 SET (ACRPDDA,DA)=ACRPDDA(ACRJ)
+3 SET DIE="^ACRPD("
+4 SET DR=".03////"_ACRLDG(ACRJ)_";.04////"_ACRMIE(ACRJ)_";.05////"_ACREFFCT_";.06////"_ACRBEGIN(ACRJ)_";.07////"_ACREND(ACRJ)
+5 IF ACRLDG(ACRJ)&ACRMIE(ACRJ)
USE 0
WRITE "."
DO DIE^ACRFDIC
+6 DO CITY
End DoDot:1
+7 QUIT
F1 ;
+1 KILL ACRPDDA
+2 NEW I
+3 SET (ACRPDDA,I)=0
+4 FOR
SET ACRPDDA=$ORDER(^ACRPD("B",ACRCNTZ,ACRPDDA))
IF 'ACRPDDA
QUIT
IF $DATA(^ACRPD(ACRPDDA,0))
IF $PIECE(^(0),U,2)=ACRSTDA
SET I=I+1
SET ACRPDDA(I)=ACRPDDA
+5 IF ACRCNTZ["PARISH"
QUIT
+6 SET (ACRPDDA,I)=0
+7 FOR
SET ACRPDDA=$ORDER(^ACRPD("B",ACRCNTZ_" COUNTY",ACRPDDA))
IF 'ACRPDDA
QUIT
IF $DATA(^ACRPD(ACRPDDA,0))
IF $PIECE(^(0),U,2)=ACRSTDA
SET I=I+1
SET ACRPDDA(I)=ACRPDDA
+8 IF ACRPD(2)]""
IF '$DATA(ACRPDDA(2))
Begin DoDot:1
+9 SET ACRCNTZ=ACRCNTZ_$SELECT(ACRCNTZ'["PARRISH":" COUNTY",1:"")_" 222"
+10 DO TEMP
+11 IF +$GET(Y)<1
QUIT
+12 SET ACRPDDA(2)=+Y
+13 SET ACRCNTZ=$PIECE(ACRCNTZ," 222")
+14 SET DA=+Y
+15 SET DIE="^ACRPD("
+16 SET DR=".01///"_ACRCNTZ
+17 USE 0
WRITE " ",ACRCNTZ," ",ACRPDDA(2),!
+18 DO DIE^ACRFDIC
End DoDot:1
+19 QUIT
TEMP ;TEMPORARILY FILE GSA CITIES/COUNTIES WHICH DON'T MATCH CURRENT ARMS
+1 ;LISTING
+2 SET X=ACRCNTZ
+3 SET DIC="^ACRPD("
+4 SET DIC(0)="L"
+5 SET DIC("DR")=".02////"_ACRSTDA
+6 USE 0
WRITE !,"2ND VENDOR ADDED"
+7 DO FILE^ACRFDIC
+8 QUIT
OPEN ;OPEN GSA FILE
+1 SET %FN="conus96.thl"
+2 SET ACROP="R"
+3 DO HOST^ACRFZIS
+4 QUIT
UPPER ;CONVERT ALL LOWER CASE TO UPPER CASE ALPHAS
+1 SET ACRX=$TRANSLATE(ACRX,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+2 QUIT
ACRX ;CONVERT EACH LINE INTO '^' DELIMITED STRING
+1 NEW J,X,Z
+2 SET Z=""
+3 FOR J=1:1:100
SET X=$PIECE(ACRX," ",J)
IF X]""
IF $EXTRACT(X)=" "
SET X=$EXTRACT(X,2,9999)
SET Z=$GET(Z)_X_U
+4 SET ACRX=Z
+5 QUIT
DATE ;EVALUATE GSA DATE AND CHANGE TO FM
+1 NEW A,W,X,Y,Z
+2 IF ACRBEGIN(I)=""
SET ACREND(I)=""
QUIT
+3 SET W=$PIECE($PIECE(ACRBEGIN(I),"-"),"(",2)
+4 SET X=$PIECE($PIECE(ACRBEGIN(I),"-",2),")")
+5 SET Y=+$PIECE(W," ",2,99)
SET Z=+$PIECE(X," ",2,99)
+6 SET W=$PIECE(W," ")
SET X=$PIECE(X," ")
+7 SET A="JANUARY1FEBRUARY2MARCH3APRIL4MAY5JUNE6JULY7AUGUST8SEPTEMBER9OCTOBER10NOVEMBER11DECEMBER12"
+8 SET W=+$PIECE(A,W,2)
+9 SET X=+$PIECE(A,X,2)
+10 SET ACRBEGIN(I)="296"_$SELECT($LENGTH(W)=1:"0",1:"")_W_$SELECT($LENGTH(Y)=1:"0",1:"")_Y
+11 SET ACREND(I)="296"_$SELECT($LENGTH(X)=1:"0",1:"")_X_$SELECT($LENGTH(Z)=1:"0",1:"")_Z
+12 QUIT
CITY ;CHECK COUNTY FOR ASSOCIATED CITIES
+1 FOR I=1:1
SET X=$PIECE(ACRCITY,"/",I)
IF X=""
QUIT
IF $EXTRACT(X)=" "
SET X=$EXTRACT(X,2,999)
Begin DoDot:1
+2 IF $DATA(^ACRPD(ACRPDDA,1,"B",X))
QUIT
+3 SET DIC="^ACRPD("_ACRPDDA_",1,"
+4 SET DIC(0)="L"
+5 SET DA(1)=ACRPDDA
+6 IF '$DATA(^ACRPD(ACRPDDA,1,0))
SET ^ACRPD(ACRPDDA,1,0)="^9002193.91"
+7 DO FILE^ACRFDIC
End DoDot:1
+8 QUIT
