BIVTAB.m

BIVTAB ;IHS/CMI/MWR - VIEW VACCINE TRANSLATION TABLE; MAY 10, 2010

 ;;8.5;IMMUNIZATION;;SEP 01,2011

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

 ;;  VIEW VACCINE TRANSLATION TABLE THROUGH LISTMANAGER.

 ;

 ;----------

START ;EP

 D SETVARS^BIUTL5 K ^TMP("BIVTAB",$J) N BITMP,DIR

 D EN

 D FULL^VALM1

 Q

 ;

 ;

 ;----------

EN ;EP

 ;---> Main entry point for option BI REPORT VACCINE TRANSLAT.

 D EN^VALM("BI VACCINE TRANS TABLE VIEW")

 Q

 ;

 ;

 ;----------

HDR ;EP

 ;---> Header code

 N BIDASH,BILINE,X,Y S BILINE=0

 D WH^BIW(.BILINE)

 S X=$$REPHDR^BIUTL6(DUZ(2)),BIDASH=$L(X)+2 D CENTERT^BIUTL5(.X)

 D WH^BIW(.BILINE,X)

 S X=$$SP^BIUTL5(BIDASH,"-") D CENTERT^BIUTL5(.X)

 D WH^BIW(.BILINE,X)

 S X="VACCINE TRANSLATION TABLE" D CENTERT^BIUTL5(.X)

 D WH^BIW(.BILINE,X)

 S X="  OLD"

 D WH^BIW(.BILINE,X)

 S X="  IHS   OLD            NEW HL7      HL7"

 D WH^BIW(.BILINE,X)

 S X="  CODE  SHORT NAME     SHORT NAME   CODE   NEW HL7 LONG NAME"

 D WH^BIW(.BILINE,X)

 Q

 ;

 ;

 ;----------

INIT ;EP

 ;---> Initialize variables and list array.

 ;

 S VALMSG="Enter ?? for more actions."

 S VALM("TITLE")=" (Immunization v"_$$VER^BILOGO_")"

 ;

 N BIN,I

 ;

 S BIN=0

 F  S BIN=$O(^BITO(BIN)) Q:'BIN  D

 .N BI0,BIY S BI0=^BITO(BIN,0)

 .;---> Old IHS Code.

 .S BI0(1)=$P(BI0,U,3)

 .;---> Old Short Name.

 .S BI0(2)=$P(BI0,U,2)

 .;---> Get pointer to new HL7 Vaccine entry.

 .S BI0(3)=$P(BI0,U,20)

 .;---> New HL7 Short Name.

 .S BI0(4)=$$VNAME^BIUTL2(BI0(3))

 .;---> New HL7 Code.

 .S BI0(5)=$$CODE^BIUTL2(BI0(3))

 .;---> New HL7 Long Name.

 .S BI0(6)=$$VNAME^BIUTL2(BI0(3),1)

 .;

 .;---> Set formatted line in ^TMP for Listman to display.

 .S BIY="   "_BI0(1)_"   "_$$PAD^BIUTL5(BI0(2),15,".")

 .S BIY=BIY_$$PAD^BIUTL5(BI0(4),13,".")_$J(BI0(5),3)

 .S BIY=BIY_"    "_$E(BI0(6),1,36)

 .;

 .S BITMP("BIVTAB",BI0(2))=BIY

 ;

 S BIN=0

 F I=1:1 S BIN=$O(BITMP("BIVTAB",BIN)) Q:BIN=""  D

 .S ^TMP("BIVTAB",$J,I,0)=BITMP("BIVTAB",BIN)

 ;

 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,HDR Q

 ;

 ;

 ;----------

HELP ;EP

 ;---> Help code.

 N BIX S BIX=X

 D FULL^VALM1

 D TITLE^BIUTL5("VACCINE TRANSLATION TABLE - HELP")

 D TEXT1,DIRZ^BIUTL3()

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

 Q

 ;

 ;

 ;----------

TEXT1 ;EP

 ;;With the installation of Immunization v7.0, new vaccines were

 ;;added to the Vaccine Table and several non-standard vaccines were

 ;;translated to new standard names.  More importantly, the old IHS

 ;;Codes for vaccines were translated to their equivalent HL7 Codes.

 ;;

 ;;This list, the Vaccine Translation Table, shows how the old IHS

 ;;Vaccine Table on your computer was converted to the new HL7 Table.

 ;;The list DOES NOT contain all of the new vaccines that are now

 ;;in your Vaccine Table--it only shows how the old Vaccines were

 ;;translated to the new HL7 Vaccine Table.  (The entire new Vaccine

 ;;Table may be viewed/printed under the Manager Menu, MGR-->VAC.)

 ;;

 ;;It may be helpful to print this list, initially, for people who

 ;;were previously using the old IHS Codes for Data Entry.  This will

 ;;show them which HL7 Codes should now be used instead.

 ;

 D PRINTX("TEXT1")

 Q

 ;

 ;

 ;----------

PRINTX(BILINL,BITAB) ;EP

 Q:$G(BILINL)=""

 N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" "

 F I=1:1 S X=$T(@BILINL+I) Q:X'[";;"  W !,T,$P(X,";;",2)

 Q

 ;

 ;

 ;----------

EXIT ;EP

 ;---> End of job cleanup.

 K ^TMP("BIVTAB",$J)

 D CLEAR^VALM1

 D FULL^VALM1

 Q

BIVTAB    ;IHS/CMI/MWR - VIEW VACCINE TRANSLATION TABLE; MAY 10, 2010

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

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

 +3       ;;  VIEW VACCINE TRANSLATION TABLE THROUGH LISTMANAGER.

 +4       ;

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

START     ;EP

 +1        DO SETVARS^BIUTL5

           KILL ^TMP("BIVTAB",$JOB)

           NEW BITMP,DIR

 +2        DO EN

 +3        DO FULL^VALM1

 +4        QUIT 

 +5       ;

 +6       ;

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

EN        ;EP

 +1       ;---> Main entry point for option BI REPORT VACCINE TRANSLAT.

 +2        DO EN^VALM("BI VACCINE TRANS TABLE VIEW")

 +3        QUIT 

 +4       ;

 +5       ;

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

HDR       ;EP

 +1       ;---> Header code

 +2        NEW BIDASH,BILINE,X,Y

           SET BILINE=0

 +3        DO WH^BIW(.BILINE)

 +4        SET X=$$REPHDR^BIUTL6(DUZ(2))

           SET BIDASH=$LENGTH(X)+2

           DO CENTERT^BIUTL5(.X)

 +5        DO WH^BIW(.BILINE,X)

 +6        SET X=$$SP^BIUTL5(BIDASH,"-")

           DO CENTERT^BIUTL5(.X)

 +7        DO WH^BIW(.BILINE,X)

 +8        SET X="VACCINE TRANSLATION TABLE"

           DO CENTERT^BIUTL5(.X)

 +9        DO WH^BIW(.BILINE,X)

 +10       SET X="  OLD"

 +11       DO WH^BIW(.BILINE,X)

 +12       SET X="  IHS   OLD            NEW HL7      HL7"

 +13       DO WH^BIW(.BILINE,X)

 +14       SET X="  CODE  SHORT NAME     SHORT NAME   CODE   NEW HL7 LONG NAME"

 +15       DO WH^BIW(.BILINE,X)

 +16       QUIT 

 +17      ;

 +18      ;

 +19      ;----------

INIT      ;EP

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

 +2       ;

 +3        SET VALMSG="Enter ?? for more actions."

 +4        SET VALM("TITLE")=" (Immunization v"_$$VER^BILOGO_")"

 +5       ;

 +6        NEW BIN,I

 +7       ;

 +8        SET BIN=0

 +9        FOR 

               SET BIN=$ORDER(^BITO(BIN))

               IF 'BIN

                   QUIT 

               Begin DoDot:1

 +10               NEW BI0,BIY

                   SET BI0=^BITO(BIN,0)

 +11      ;---> Old IHS Code.

 +12               SET BI0(1)=$PIECE(BI0,U,3)

 +13      ;---> Old Short Name.

 +14               SET BI0(2)=$PIECE(BI0,U,2)

 +15      ;---> Get pointer to new HL7 Vaccine entry.

 +16               SET BI0(3)=$PIECE(BI0,U,20)

 +17      ;---> New HL7 Short Name.

 +18               SET BI0(4)=$$VNAME^BIUTL2(BI0(3))

 +19      ;---> New HL7 Code.

 +20               SET BI0(5)=$$CODE^BIUTL2(BI0(3))

 +21      ;---> New HL7 Long Name.

 +22               SET BI0(6)=$$VNAME^BIUTL2(BI0(3),1)

 +23      ;

 +24      ;---> Set formatted line in ^TMP for Listman to display.

 +25               SET BIY="   "_BI0(1)_"   "_$$PAD^BIUTL5(BI0(2),15,".")

 +26               SET BIY=BIY_$$PAD^BIUTL5(BI0(4),13,".")_$JUSTIFY(BI0(5),3)

 +27               SET BIY=BIY_"    "_$EXTRACT(BI0(6),1,36)

 +28      ;

 +29               SET BITMP("BIVTAB",BI0(2))=BIY

               End DoDot:1

 +30      ;

 +31       SET BIN=0

 +32       FOR I=1:1

               SET BIN=$ORDER(BITMP("BIVTAB",BIN))

               IF BIN=""

                   QUIT 

               Begin DoDot:1

 +33               SET ^TMP("BIVTAB",$JOB,I,0)=BITMP("BIVTAB",BIN)

               End DoDot:1

 +34      ;

 +35       SET VALMCNT=I-1

 +36       QUIT 

 +37      ;

 +38      ;

 +39      ;----------

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

           DO HDR

           QUIT 

 +5       ;

 +6       ;

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

HELP      ;EP

 +1       ;---> Help code.

 +2        NEW BIX

           SET BIX=X

 +3        DO FULL^VALM1

 +4        DO TITLE^BIUTL5("VACCINE TRANSLATION TABLE - HELP")

 +5        DO TEXT1

           DO DIRZ^BIUTL3()

 +6        IF BIX'="??"

               DO RE^VALM4

 +7        QUIT 

 +8       ;

 +9       ;

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

TEXT1     ;EP

 +1       ;;With the installation of Immunization v7.0, new vaccines were

 +2       ;;added to the Vaccine Table and several non-standard vaccines were

 +3       ;;translated to new standard names.  More importantly, the old IHS

 +4       ;;Codes for vaccines were translated to their equivalent HL7 Codes.

 +5       ;;

 +6       ;;This list, the Vaccine Translation Table, shows how the old IHS

 +7       ;;Vaccine Table on your computer was converted to the new HL7 Table.

 +8       ;;The list DOES NOT contain all of the new vaccines that are now

 +9       ;;in your Vaccine Table--it only shows how the old Vaccines were

 +10      ;;translated to the new HL7 Vaccine Table.  (The entire new Vaccine

 +11      ;;Table may be viewed/printed under the Manager Menu, MGR-->VAC.)

 +12      ;;

 +13      ;;It may be helpful to print this list, initially, for people who

 +14      ;;were previously using the old IHS Codes for Data Entry.  This will

 +15      ;;show them which HL7 Codes should now be used instead.

 +16      ;

 +17       DO PRINTX("TEXT1")

 +18       QUIT 

 +19      ;

 +20      ;

 +21      ;----------

PRINTX(BILINL,BITAB) ;EP

 +1        IF $GET(BILINL)=""

               QUIT 

 +2        NEW I,T,X

           SET T=""

           IF '$DATA(BITAB)

               SET BITAB=5

           FOR I=1:1:BITAB

               SET T=T_" "

 +3        FOR I=1:1

               SET X=$TEXT(@BILINL+I)

               IF X'[";;"

                   QUIT 

               WRITE !,T,$PIECE(X,";;",2)

 +4        QUIT 

 +5       ;

 +6       ;

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

EXIT      ;EP

 +1       ;---> End of job cleanup.

 +2        KILL ^TMP("BIVTAB",$JOB)

 +3        DO CLEAR^VALM1

 +4        DO FULL^VALM1

 +5        QUIT