Routine: ADERVURD

ADERVURD ;IHS/ITSC/TPF - READ NEW RVUS FROM FILE AND PLACE INTO ADA CODE FILE 8/27/2003 12:50:16 PM

 ;;6.0;ADE;**15**;JAN 01, 2004

 S U="^"

ASK W @IOF

 K DIR

 S DIR("B")=$G(^XTV(8989.3,1,"DEV"))

 S DIR(0)="FO",DIR("A")="Enter the directory path for the RVU Code update file "

 S DIR("?")="/usr/mydir or c:\pub\"

 S ERROR=0

 D ^DIR

 I $D(DIRUT) D EXIT Q

 I Y=""!(Y=U)!(Y=(U_U)) D EXIT Q

 S XBDIR=X

 K DIR

 D FNAME

 I $G(XBFN)="" G ASK

 D RDFILE(XBDIR,XBFN)

 I ERROR G ASK

 D PLACE

 D EXIT

 G ASK

 ; pull up a file into the TMP global for display

RDFILE(XBDIR,XBFN,XBNODE) ;

 S ERROR=0

 I '$D(XBHDR) S XBHDR=""

 N Y,X,I

 S Y=$$OPEN^%ZISH(XBDIR,XBFN,"R")

 I POP W !,*7,"CANNOT OPEN (OR ACCESS) FILE '",XBDIR,XBFN,"'." S Y=$$DIR^XBDIR("E") S ERROR=1 Q

 K ^TMP("ADERVURD",$J)

 U 0 W !!,"READING FROM FILE "

 F I=1:1 U IO R X:DTIME S X=$TR(X,$C(9),U) Q:X=""  S ^TMP("ADERVURD",$J,I,0)=X U 0 W "." Q:$$STATUS^%ZISH=-1

 U 0 W !,I," RECORDS READ"

 D CLOSE^%ZISH()

 ;PUT DATA INTO ADA CODE FILE

PLACE ;

 W !!,"ADDING RVU INFO TO 'ADA CODE' FILE"

 S RECORD=1

 F  S RECORD=$O(^TMP("ADERVURD",$J,RECORD)) Q:RECORD=""  D

 .S ADACODE=$TR($P(^TMP("ADERVURD",$J,RECORD,0),U),"D")

 .Q:$E(ADACODE,1,2)="IH"  ;USER DEFINED SKIP FOR NOW

 .S RVU=$P(^TMP("ADERVURD",$J,RECORD,0),U,5)     ;GET RELATIVE VALUE UNIT

 .S ADANLC=$P(^TMP("ADERVURD",$J,RECORD,0),U,4)  ;GET NEW LEVEL OF SERVICE (CARE)

 .S ADADESCR=$P(^TMP("ADERVURD",$J,RECORD,0),U,2)

 .D ADDTOFIL(ADACODE,RVU,ADADESCR,ADANLC)  ;ADD TO THE FILE

 I $D(^TMP("ADERVURD","EXCEPTIONS",$J)) D EXCEPTRP  ;DO EXCEPTION REPORT

 ;CLEAN UP

EXIT K ADACODE,ADADESCR,ADAIEN,DA,DIE,DR,ERROR,I,MSG,RECORD,RVU,CENTER,LINE,ADANLC

 K ^TMP("ADERVURD",$J)

 I $D(^TMP("ADERVURD","EXCEPTIONS",$J)) K ^TMP("ADERVURD","EXCEPTIONS",$J) W !!,"EXCEPTION FILE HAS BEEN DELETED!"

 ;ADD TO THE ADAD CODE FILE

ADDTOFIL(ADACODE,RVU,ADADESCR,ADANLC) ;

 W "."

 S XREF="BA"

 S ADAIEN=$O(^AUTTADA("BA",ADACODE_" ",""))

 I ADAIEN="" D EXCEPT("ENTRY FOR "_ADACODE_" NOT FOUND USING "_XREF_" X-REF",ADACODE,ADADESCR)

 S XREF="B"

 S ADAIEN=$O(^AUTTADA("B",ADACODE,""))

 I ADAIEN="" D EXCEPT("INTERNAL ENTRY NUMBER NOT FOUND USING X-REF "_XREF_" FOR ADA CODE "_ADACODE_". RVU HAS NOT BEEN ENTERED INTO FILE",ADACODE,ADADESCR) Q

 I $D(^AUTTADA(ADAIEN,0))'=1 D EXCEPT("MISSING ZERO NODE WITH ENTRY FOR "_ADAIEN_" X-REF EXISTS BUT ZERO NODE DOES NOT",ADAIEN,ADADESCR) Q

 D UPDATE(ADAIEN,RVU,ADANLC)

 ;ADD RVU TO ENTRY

UPDATE(ADAIEN,RVU,ADANLC) ;

 ;UPDATE RVU AND LEVEL OF SERVICE

 S DIE="^AUTTADA("

 S DA=ADAIEN

 S DR=".05///^S X=ADANLC;501///^S X=RVU"

 D ^DIE

 K DIE

 ;REPORT/PROCESS EXCEPTION

EXCEPT(MSG,ADACODE,ADADESCR) ;

 S ^TMP("ADERVURD","EXCEPTIONS",$J,ADACODE)=MSG_U_ADADESCR

 ;W !,MSG

 ;FOLLOWING CODE BORROWED WITH PERMISSION FROM ROUTINE BAREDIUT

FNAME ;

 ; Select a file (directory can be pre-loaded into XBDIR)

 K DIR

FNAME1 ;

 S XBFN=""

 S DIR(0)="FO^1:15"

 S DIR("A")="File Name "

 D ^DIR

 K DIR

 Q:$G(DTOUT)

 Q:Y["^"

 Q:Y=""

 I Y?.N,$D(XBFL(Y)) S DIR("B")=XBFL(Y) G FNAME1

 I Y["*" D  G FNAME

 . K XBFL

 . S X=$$LIST^%ZISH(XBDIR,Y,.XBFL)

 . F XBI=1:1 Q:'$D(XBFL(XBI))  W !?5,XBI,?10,XBFL(XBI) I '(XBI#20) R X:DTIME

 S XBFN=Y

 ;EXCEPTION REPORT

EXCEPTRP ;

 W !,"EXCEPTIONS HAVE BEEN FOUND"

 K DIR

 S DIR(0)="Y"

 S DIR("A")="VIEW EXCEPTION REPORT(Y/N)"

 S DIR("B")="N"

 D ^DIR

 Q:'Y

 S $P(LINE,"*",IOM+1)=""

 D ^%ZIS Q:POP

 U IO

 D HDR

 S ADACODE=""

 F  S ADACODE=$O(^TMP("ADERVURD","EXCEPTIONS",$J,ADACODE)) Q:ADACODE=""  D

 .S ADADESCR=$P(^TMP("ADERVURD","EXCEPTIONS",$J,ADACODE),U,2)

 .W !!,ADACODE,?10,ADADESCR

 .I $Y>(IOSL-4),IOST'[("C-") D HDR Q

 .I $Y>(IOSL-4) D RETURN,HDR

 I IOST[("C-") D RETURN

 W @IOF

 D ^%ZISC

HDR ;

 W @IOF

 S X="EXCEPTION REPORT"

 S CENTER=(IOM-$L(X))\2

 W !,?CENTER,X

 S X="THE FOLLOWING ADA CODES WERE NOT FOUND IN FILE #9999999.31"

 S CENTER=(IOM-$L(X))\2

 W !,?CENTER,X

 W !!,"ADA CODE",?10,"DESCRIPTION"

 W !,LINE

RETURN ;EP - Press return to continue

 N DIR

 S DIR(0)="FAO^1:1",DIR("A")="Press 'Return' to continue... "

 W !! D ^DIR

 K DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT

ADERVURD  ;IHS/ITSC/TPF - READ NEW RVUS FROM FILE AND PLACE INTO ADA CODE FILE 8/27/2003 12:50:16 PM

 +1       ;;6.0;ADE;**15**;JAN 01, 2004

 +2        SET U="^"

ASK        WRITE @IOF

 +1        KILL DIR

 +2        SET DIR("B")=$GET(^XTV(8989.3,1,"DEV"))

 +3        SET DIR(0)="FO"

           SET DIR("A")="Enter the directory path for the RVU Code update file "

 +4        SET DIR("?")="/usr/mydir or c:\pub\"

 +5        SET ERROR=0

 +6        DO ^DIR

 +7        IF $DATA(DIRUT)

               DO EXIT

               QUIT

 +8        IF Y=""!(Y=U)!(Y=(U_U))

               DO EXIT

               QUIT

 +9        SET XBDIR=X

 +10       KILL DIR

 +11       DO FNAME

 +12       IF $GET(XBFN)=""

               GOTO ASK

 +13       DO RDFILE(XBDIR,XBFN)

 +14       IF ERROR

               GOTO ASK

 +15       DO PLACE

 +16       DO EXIT

 +17       GOTO ASK

 +18       QUIT

 +19      ; pull up a file into the TMP global for display

RDFILE(XBDIR,XBFN,XBNODE) ;

 +1        SET ERROR=0

 +2        IF '$DATA(XBHDR)

               SET XBHDR=""

 +3        NEW Y,X,I

 +4        SET Y=$$OPEN^%ZISH(XBDIR,XBFN,"R")

 +5        IF POP

               WRITE !,*7,"CANNOT OPEN (OR ACCESS) FILE '",XBDIR,XBFN,"'."

               SET Y=$$DIR^XBDIR("E")

               SET ERROR=1

               QUIT

 +6        KILL ^TMP("ADERVURD",$JOB)

 +7        USE 0

           WRITE !!,"READING FROM FILE "

 +8        FOR I=1:1

               USE IO

               READ X:DTIME

               SET X=$TRANSLATE(X,$CHAR(9),U)

               IF X=""

                   QUIT

               SET ^TMP("ADERVURD",$JOB,I,0)=X

               USE 0

               WRITE "."

               IF $$STATUS^%ZISH=-1

                   QUIT

 +9        USE 0

           WRITE !,I," RECORDS READ"

 +10       DO CLOSE^%ZISH()

 +11       QUIT

 +12      ;PUT DATA INTO ADA CODE FILE

PLACE     ;

 +1        WRITE !!,"ADDING RVU INFO TO 'ADA CODE' FILE"

 +2        SET RECORD=1

 +3        FOR

               SET RECORD=$ORDER(^TMP("ADERVURD",$JOB,RECORD))

               IF RECORD=""

                   QUIT

               Begin DoDot:1

 +4                SET ADACODE=$TRANSLATE($PIECE(^TMP("ADERVURD",$JOB,RECORD,0),U),"D")

 +5       ;USER DEFINED SKIP FOR NOW

                   IF $EXTRACT(ADACODE,1,2)="IH"

                       QUIT

 +6       ;GET RELATIVE VALUE UNIT

                   SET RVU=$PIECE(^TMP("ADERVURD",$JOB,RECORD,0),U,5)

 +7       ;GET NEW LEVEL OF SERVICE (CARE)

                   SET ADANLC=$PIECE(^TMP("ADERVURD",$JOB,RECORD,0),U,4)

 +8                SET ADADESCR=$PIECE(^TMP("ADERVURD",$JOB,RECORD,0),U,2)

 +9       ;ADD TO THE FILE

                   DO ADDTOFIL(ADACODE,RVU,ADADESCR,ADANLC)

               End DoDot:1

 +10      ;DO EXCEPTION REPORT

           IF $DATA(^TMP("ADERVURD","EXCEPTIONS",$JOB))

               DO EXCEPTRP

 +11       QUIT

 +12      ;CLEAN UP

EXIT       KILL ADACODE,ADADESCR,ADAIEN,DA,DIE,DR,ERROR,I,MSG,RECORD,RVU,CENTER,LINE,ADANLC

 +1        KILL ^TMP("ADERVURD",$JOB)

 +2        IF $DATA(^TMP("ADERVURD","EXCEPTIONS",$JOB))

               KILL ^TMP("ADERVURD","EXCEPTIONS",$JOB)

               WRITE !!,"EXCEPTION FILE HAS BEEN DELETED!"

 +3        QUIT

 +4       ;

 +5       ;ADD TO THE ADAD CODE FILE

ADDTOFIL(ADACODE,RVU,ADADESCR,ADANLC) ;

 +1        WRITE "."

 +2        SET XREF="BA"

 +3        SET ADAIEN=$ORDER(^AUTTADA("BA",ADACODE_" ",""))

 +4        IF ADAIEN=""

               DO EXCEPT("ENTRY FOR "_ADACODE_" NOT FOUND USING "_XREF_" X-REF",ADACODE,ADADESCR)

 +5        SET XREF="B"

 +6        SET ADAIEN=$ORDER(^AUTTADA("B",ADACODE,""))

 +7        IF ADAIEN=""

               DO EXCEPT("INTERNAL ENTRY NUMBER NOT FOUND USING X-REF "_XREF_" FOR ADA CODE "_ADACODE_". RVU HAS NOT BEEN ENTERED INTO FILE",ADACODE,ADADESCR)

               QUIT

 +8        IF $DATA(^AUTTADA(ADAIEN,0))'=1

               DO EXCEPT("MISSING ZERO NODE WITH ENTRY FOR "_ADAIEN_" X-REF EXISTS BUT ZERO NODE DOES NOT",ADAIEN,ADADESCR)

               QUIT

 +9        DO UPDATE(ADAIEN,RVU,ADANLC)

 +10       QUIT

 +11      ;ADD RVU TO ENTRY

UPDATE(ADAIEN,RVU,ADANLC) ;

 +1       ;UPDATE RVU AND LEVEL OF SERVICE

 +2        SET DIE="^AUTTADA("

 +3        SET DA=ADAIEN

 +4        SET DR=".05///^S X=ADANLC;501///^S X=RVU"

 +5        DO ^DIE

 +6        KILL DIE

 +7        QUIT

 +8       ;REPORT/PROCESS EXCEPTION

EXCEPT(MSG,ADACODE,ADADESCR) ;

 +1        SET ^TMP("ADERVURD","EXCEPTIONS",$JOB,ADACODE)=MSG_U_ADADESCR

 +2       ;W !,MSG

 +3        QUIT

 +4       ;FOLLOWING CODE BORROWED WITH PERMISSION FROM ROUTINE BAREDIUT

FNAME     ;

 +1       ; Select a file (directory can be pre-loaded into XBDIR)

 +2        KILL DIR

 +3       ;

FNAME1    ;

 +1        SET XBFN=""

 +2        SET DIR(0)="FO^1:15"

 +3        SET DIR("A")="File Name "

 +4        DO ^DIR

 +5        KILL DIR

 +6        IF $GET(DTOUT)

               QUIT

 +7        IF Y["^"

               QUIT

 +8        IF Y=""

               QUIT

 +9        IF Y?.N

               IF $DATA(XBFL(Y))

                   SET DIR("B")=XBFL(Y)

                   GOTO FNAME1

 +10       IF Y["*"

               Begin DoDot:1

 +11               KILL XBFL

 +12               SET X=$$LIST^%ZISH(XBDIR,Y,.XBFL)

 +13               FOR XBI=1:1

                       IF '$DATA(XBFL(XBI))

                           QUIT

                       WRITE !?5,XBI,?10,XBFL(XBI)

                       IF '(XBI#20)

                           READ X:DTIME

               End DoDot:1

               GOTO FNAME

 +14       SET XBFN=Y

 +15       QUIT

 +16      ;EXCEPTION REPORT

EXCEPTRP  ;

 +1        WRITE !,"EXCEPTIONS HAVE BEEN FOUND"

 +2        KILL DIR

 +3        SET DIR(0)="Y"

 +4        SET DIR("A")="VIEW EXCEPTION REPORT(Y/N)"

 +5        SET DIR("B")="N"

 +6        DO ^DIR

 +7        IF 'Y

               QUIT

 +8        SET $PIECE(LINE,"*",IOM+1)=""

 +9        DO ^%ZIS

           IF POP

               QUIT

 +10       USE IO

 +11       DO HDR

 +12       SET ADACODE=""

 +13       FOR

               SET ADACODE=$ORDER(^TMP("ADERVURD","EXCEPTIONS",$JOB,ADACODE))

               IF ADACODE=""

                   QUIT

               Begin DoDot:1

 +14               SET ADADESCR=$PIECE(^TMP("ADERVURD","EXCEPTIONS",$JOB,ADACODE),U,2)

 +15               WRITE !!,ADACODE,?10,ADADESCR

 +16               IF $Y>(IOSL-4)

                       IF IOST'[("C-")

                           DO HDR

                           QUIT

 +17               IF $Y>(IOSL-4)

                       DO RETURN

                       DO HDR

               End DoDot:1

 +18       IF IOST[("C-")

               DO RETURN

 +19       WRITE @IOF

 +20       DO ^%ZISC

 +21       QUIT

HDR       ;

 +1        WRITE @IOF

 +2        SET X="EXCEPTION REPORT"

 +3        SET CENTER=(IOM-$LENGTH(X))\2

 +4        WRITE !,?CENTER,X

 +5        SET X="THE FOLLOWING ADA CODES WERE NOT FOUND IN FILE #9999999.31"

 +6        SET CENTER=(IOM-$LENGTH(X))\2

 +7        WRITE !,?CENTER,X

 +8        WRITE !!,"ADA CODE",?10,"DESCRIPTION"

 +9        WRITE !,LINE

 +10       QUIT

RETURN    ;EP - Press return to continue

 +1        NEW DIR

 +2        SET DIR(0)="FAO^1:1"

           SET DIR("A")="Press 'Return' to continue... "

 +3        WRITE !!

           DO ^DIR

 +4        KILL DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT

 +5        QUIT

ADERVURD.m