BIETAB.m

BIETAB ;IHS/CMI/MWR - VIEW ERROR CODE TABLE; MAY 10, 2010

 ;;8.5;IMMUNIZATION;;SEP 01,2011

 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 ;;  VIEW BI TABLE ERROR CODE THROUGH LISTMANAGER.

 ;;  NOT CALLED FROM MENUS, PROGRAMMER USE.

 ;

 ;----------

START ;EP

 ;---> Display Error Code table.

 ;

 D SETVARS^BIUTL5

 D EN

 D EXIT

 Q

 ;

 ;

 ;----------

EN ;EP

 D EN^VALM("BI TABLE ERROR CODE VIEW")

 Q

 ;

 ;

 ;----------

INIT ;EP

 ;---> Initialize variables and list array.

 N N,I

 S N=0

 F I=1:1 S N=$O(^BIERR(N)) Q:'N  D

 .S ^TMP("BIETAB",$J,I,0)="  "_N_"  "_$P(^BIERR(N,0),U,2)

 S VALMCNT=I-1

 Q

 ;

 ;

 ;----------

RESET ;EP

 ;---> Update partition for return to Listmanager.

 I $D(VALMQUIT) S VALMBCK="Q" Q

 D TERM^VALM0 S VALMBCK="R"

 D INIT Q

 ;

 ;

 ;----------

HELP ;EP

 ;---> Help code.

 N BIX S BIX=X

 D FULL^VALM1

 W !!?5,"Use arrow keys to scroll up and down through the list, or"

 W !?5,"enter ""A"", then an Error Code Number in order  to Add, Edit"

 W !?5,"or Delete an Error Code, or"

 W !?5,"type ""??"" for more actions, such as Search and Print List."

 D DIRZ^BIUTL3("","     Press ENTER/RETURN to continue")

 D:BIX'="??" RE^VALM4

 Q

 ;

 ;

 ;----------

EXIT ;EP

 ;---> Cleanup, EOJ.

 D KILLALL^BIUTL8()

 K ^TMP("BIETAB",$J)

 D CLEAR^VALM1

 D FULL^VALM1

 Q

 ;

 ;

 ;----------

ADDEDEL ;EP

 ;---> Add/Edit/Delete Error Codes.

 ;

 D FULL^VALM1

 D TITLE^BIUTL5("ADD/EDIT/DELETE ERROR CODES")

 W !!?3,"This is your big chance to add/edit/delete Error Codes!",!!

 N Y

 D DIC^BIFMAN(9002084.33,"QEMAL",.Y,"   Select ERROR CODE: ")

 I Y<1 D RESET Q

 S DR=".01;.02;.03"

 D DIE^BIFMAN(9002084.33,DR,+Y)

 D RESET

 Q

BIETAB    ;IHS/CMI/MWR - VIEW ERROR CODE TABLE; MAY 10, 2010

 +1       ;;8.5;IMMUNIZATION;;SEP 01,2011

 +2       ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 +3       ;;  VIEW BI TABLE ERROR CODE THROUGH LISTMANAGER.

 +4       ;;  NOT CALLED FROM MENUS, PROGRAMMER USE.

 +5       ;

 +6       ;----------

START     ;EP

 +1       ;---> Display Error Code table.

 +2       ;

 +3        DO SETVARS^BIUTL5

 +4        DO EN

 +5        DO EXIT

 +6        QUIT 

 +7       ;

 +8       ;

 +9       ;----------

EN        ;EP

 +1        DO EN^VALM("BI TABLE ERROR CODE VIEW")

 +2        QUIT 

 +3       ;

 +4       ;

 +5       ;----------

INIT      ;EP

 +1       ;---> Initialize variables and list array.

 +2        NEW N,I

 +3        SET N=0

 +4        FOR I=1:1

               SET N=$ORDER(^BIERR(N))

               IF 'N

                   QUIT 

               Begin DoDot:1

 +5                SET ^TMP("BIETAB",$JOB,I,0)="  "_N_"  "_$PIECE(^BIERR(N,0),U,2)

               End DoDot:1

 +6        SET VALMCNT=I-1

 +7        QUIT 

 +8       ;

 +9       ;

 +10      ;----------

RESET     ;EP

 +1       ;---> Update partition for return to Listmanager.

 +2        IF $DATA(VALMQUIT)

               SET VALMBCK="Q"

               QUIT 

 +3        DO TERM^VALM0

           SET VALMBCK="R"

 +4        DO INIT

           QUIT 

 +5       ;

 +6       ;

 +7       ;----------

HELP      ;EP

 +1       ;---> Help code.

 +2        NEW BIX

           SET BIX=X

 +3        DO FULL^VALM1

 +4        WRITE !!?5,"Use arrow keys to scroll up and down through the list, or"

 +5        WRITE !?5,"enter ""A"", then an Error Code Number in order  to Add, Edit"

 +6        WRITE !?5,"or Delete an Error Code, or"

 +7        WRITE !?5,"type ""??"" for more actions, such as Search and Print List."

 +8        DO DIRZ^BIUTL3("","     Press ENTER/RETURN to continue")

 +9        IF BIX'="??"

               DO RE^VALM4

 +10       QUIT 

 +11      ;

 +12      ;

 +13      ;----------

EXIT      ;EP

 +1       ;---> Cleanup, EOJ.

 +2        DO KILLALL^BIUTL8()

 +3        KILL ^TMP("BIETAB",$JOB)

 +4        DO CLEAR^VALM1

 +5        DO FULL^VALM1

 +6        QUIT 

 +7       ;

 +8       ;

 +9       ;----------

ADDEDEL   ;EP

 +1       ;---> Add/Edit/Delete Error Codes.

 +2       ;

 +3        DO FULL^VALM1

 +4        DO TITLE^BIUTL5("ADD/EDIT/DELETE ERROR CODES")

 +5        WRITE !!?3,"This is your big chance to add/edit/delete Error Codes!",!!

 +6        NEW Y

 +7        DO DIC^BIFMAN(9002084.33,"QEMAL",.Y,"   Select ERROR CODE: ")

 +8        IF Y<1

               DO RESET

               QUIT 

 +9        SET DR=".01;.02;.03"

 +10       DO DIE^BIFMAN(9002084.33,DR,+Y)

 +11       DO RESET

 +12       QUIT