ACRFPERD.m

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