Routine: BIEXP1

BIEXP1 ;IHS/CMI/MWR - EXPORT IMMUNIZATION RECORDS.; MAY 10, 2010

 ;;8.5;IMMUNIZATION;;SEP 01,2011

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

 ;;  EXPORT IMMUNIZATION RECORDS: SELECT BY INDIVIDUAL PATIENTS.

 ;----------

START ;EP

 ;---> Listman Screen for selecting Export Parameters, by Individual.

 D SETVARS^BIUTL5

 ;---> Main entry point for Export by Individual Patients.

 D EN^VALM("BI EXPORT BY INDIVIDUALS")

 D EXIT

 ;----------

INIT ;EP

 ;---> Initialize variables and list array.

 S BIPG=9,BIAG="",BIHCF("ALL")="",BICC("ALL")=""

 S VALM("TITLE")=$$LMVER^BILOGO

 S VALMSG="Select a left column number to change an item."

 N BILINE,X S BILINE=0

 D WRITE(.BILINE)

 S X=IOUON_"EXPORT DATA BY INDIVIDUALS" D CENTERT^BIUTL5(.X,42)

 D WRITE(.BILINE,X_IOINORM)

K X

 ;---> Survey Date.

 D WRITE(.BILINE,,1)

 S:'$G(BISVDT) BISVDT=DT

 S X="     1 - Survey Date..............: "_$$TXDT1^BIUTL5(BISVDT)

 D WRITE(.BILINE,X,1)

K X

 ;---> Patients, individuals.

 N BII,BIPAT1 S BII=0,BIPAT1=""

 .I '$D(BIPAT) S BIPAT1="None" Q

 .I $D(BIPAT("ALL")) S BIPAT1="ALL" Q

 .N M,N

 .S N=0

 .F BII=0:1 S N=$O(BIPAT(N)) Q:'N  S M=N

 .I BII=1 S BIPAT1=$$NAME^BIUTL1(M) Q

 .S BIPAT1="List (Select ""2"" to review list.)"

 S X="     2 - Patient"_$S(BII=1:".",1:"s")

 S X=X_".................: "_BIPAT1

 D WRITE(.BILINE,X,1)

K X

 ;---> Immunizations Received.

 N BIMMR1 S BIMMR1=""

 .S:'$D(BIMMR) BIMMR("ALL")=""

 .I $D(BIMMR("ALL")) S BIMMR1="ALL" Q

 .N I,M,N

 .S N=0

 .F I=0:1 S N=$O(BIMMR(N)) Q:'N  S M=N

 .I I=1 S BIMMR1=$$VNAME^BIUTL2(M) Q

 .S BIMMR1="List (Select ""3"" to review list.)"

 S X="     3 - Immunizations Received...: "_BIMMR1

 D WRITE(.BILINE,X,1)

K X

 ;---> Data Elements.

 N BIDE1 S BIDE1=""

 .I '$D(BIDE) S BIDE1="None" Q

 .I $D(BIDE("ALL")) S BIDE1="ALL" Q

 .N I,M,N

 .S N=0

 .F I=0:1 S N=$O(BIDE(N)) Q:'N  S M=N

 .I I=1 S BIDE1=$$DETX^BIUTL6(M) Q

 .S BIDE1="List (Select ""4"" to review list.)"

 S X="     4 - Data Elements............: "_BIDE1

 D WRITE(.BILINE,X,1)

K X

 ;---> File Format (1=ASCII,2=HL7,3=ImmServe).

 S:'$G(BIFMT) BIFMT=1

 N BIFMT1

 S BIFMT1=$S(BIFMT=2:"HL7",BIFMT=3:"ImmServe",1:"ASCII")

 S X="     5 - File Format..............: "_BIFMT1

 D WRITE(.BILINE,X,1)

K X

 ;---> Output.

 .I '$G(BIOUT) S BIOUT=0,BIFLNM="" Q

 .I $G(BIFLNM)="" S BIOUT=0

 N BIOUT1

 S BIOUT1=$S(BIOUT:"File: "_$G(BIPATH)_BIFLNM,1:"SCREEN")

 S X="     6 - Output Device............: "_BIOUT1

 D WRITE(.BILINE,X)

K X

 ;---> Finish up Listmanager List Count.

 S VALMCNT=BILINE

 S BIRTN="BIEXP1"

 ;----------

WRITE(BILINE,BIVAL,BIBLNK) ;EP

 ;---> Write lines to ^TMP (see documentation in ^BIW).

 ;---> Parameters:

 ;     1 - BILINE (ret) Last line# written.

 ;     2 - BIVAL  (opt) Value/text of line (Null=blank line).

 ;     3 - BIBLNK (opt) Number of blank lines to add after line sent.

 Q:'$D(BILINE)

 D WL^BIW(.BILINE,"BIEXP1",$G(BIVAL),$G(BIBLNK))

 ;----------

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.

 D FULL^VALM1 N BIPOP

 D TITLE^BIUTL5("EXPORT DATA BY INDIVIDUALS - HELP, page 1 of 2")

 D TEXT1,DIRZ^BIUTL3(.BIPOP)

 I $G(BIPOP) D RESET Q

 D TITLE^BIUTL5("EXPORT DATA BY INDIVIDUALS - HELP, page 2 of 2")

 D TEXT2,DIRZ^BIUTL3()

 D RESET

 ;----------

TEXT1 ;

 ;;The EXPORT DATA BY INDIVIDUALS screen provides a menu of options

 ;;for exporting the data of individual patients.

;;

 ;;There are 6 items or "parameters" on the screen that you may

 ;;change in order to specify which patients and which data will be

 ;;exported, as well as the output device for the export.

;;

 ;;To change an item, enter its left column number (1-6) at the

 ;;prompt on the bottom of the screen.  Use "?" at any prompt where

 ;;you would like help or more information on the parameter you are

 ;;changing.

;;

 ;;Once you have the parameters set to retrieve the patients and data

 ;;you want, select E to Export the data.

;;

 D PRINTX("TEXT1")

 ;----------

TEXT2 ;EP

 ;;SURVEY DATE: A past or prsent date, after which immunizations

 ;;will not be included in the export.

;;

 ;;PATIENTS: Select the patients whose data you wish to export.

;;

 ;;VACCINES: If you select for specific Vaccines, only immunizations

 ;;given with the selected vaccines will be included in the export.

;;

 ;;DATE ELEMENTS: Select the group of Data Elements you wish to export

 ;;for each immunization.

;;

 ;;FILE FORMAT and OUTPUT DEVICE: Detailed help will be given when

 ;;you select these items.

;;

 D PRINTX("TEXT2")

 ;----------

TEXT3 ;

 ;;                              NOTE

 ;;                             ------

;;

 ;;The Quarterly Immunization Report may contain some patients who

 ;;were ACTIVE prior to the Quarter Ending Date you selected, but who

 ;;are now INACTIVE.

;;

 ;;The Due List you are about to view will contain only ACTIVE patients

 ;;unless you specify otherwise.

;;

;;

;;

;;

;;

 D PRINTX("TEXT3")

 ;----------

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)

 ;----------

EXIT ;EP

 ;---> EOJ cleanup.

 K ^TMP("BIEXP1",$J)

 D CLEAR^VALM1

 D FULL^VALM1

BIEXP1    ;IHS/CMI/MWR - EXPORT IMMUNIZATION RECORDS.; MAY 10, 2010

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

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

 +3       ;;  EXPORT IMMUNIZATION RECORDS: SELECT BY INDIVIDUAL PATIENTS.

 +4       ;

 +5       ;

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

START     ;EP

 +1       ;---> Listman Screen for selecting Export Parameters, by Individual.

 +2       ;

 +3        DO SETVARS^BIUTL5

 +4       ;---> Main entry point for Export by Individual Patients.

 +5        DO EN^VALM("BI EXPORT BY INDIVIDUALS")

 +6        DO EXIT

 +7        QUIT

 +8       ;

 +9       ;

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

INIT      ;EP

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

 +2        SET BIPG=9

           SET BIAG=""

           SET BIHCF("ALL")=""

           SET BICC("ALL")=""

 +3       ;

 +4        SET VALM("TITLE")=$$LMVER^BILOGO

 +5        SET VALMSG="Select a left column number to change an item."

 +6        NEW BILINE,X

           SET BILINE=0

 +7        DO WRITE(.BILINE)

 +8        SET X=IOUON_"EXPORT DATA BY INDIVIDUALS"

           DO CENTERT^BIUTL5(.X,42)

 +9        DO WRITE(.BILINE,X_IOINORM)

 +10       KILL X

 +11      ;

 +12      ;---> Survey Date.

 +13       DO WRITE(.BILINE,,1)

 +14       IF '$GET(BISVDT)

               SET BISVDT=DT

 +15       SET X="     1 - Survey Date..............: "_$$TXDT1^BIUTL5(BISVDT)

 +16       DO WRITE(.BILINE,X,1)

 +17       KILL X

 +18      ;

 +19      ;---> Patients, individuals.

 +20       NEW BII,BIPAT1

           SET BII=0

           SET BIPAT1=""

 +21       Begin DoDot:1

 +22           IF '$DATA(BIPAT)

                   SET BIPAT1="None"

                   QUIT

 +23           IF $DATA(BIPAT("ALL"))

                   SET BIPAT1="ALL"

                   QUIT

 +24           NEW M,N

 +25           SET N=0

 +26           FOR BII=0:1

                   SET N=$ORDER(BIPAT(N))

                   IF 'N

                       QUIT

                   SET M=N

 +27           IF BII=1

                   SET BIPAT1=$$NAME^BIUTL1(M)

                   QUIT

 +28           SET BIPAT1="List (Select ""2"" to review list.)"

           End DoDot:1

 +29       SET X="     2 - Patient"_$SELECT(BII=1:".",1:"s")

 +30       SET X=X_".................: "_BIPAT1

 +31       DO WRITE(.BILINE,X,1)

 +32       KILL X

 +33      ;

 +34      ;---> Immunizations Received.

 +35       NEW BIMMR1

           SET BIMMR1=""

 +36       Begin DoDot:1

 +37           IF '$DATA(BIMMR)

                   SET BIMMR("ALL")=""

 +38           IF $DATA(BIMMR("ALL"))

                   SET BIMMR1="ALL"

                   QUIT

 +39           NEW I,M,N

 +40           SET N=0

 +41           FOR I=0:1

                   SET N=$ORDER(BIMMR(N))

                   IF 'N

                       QUIT

                   SET M=N

 +42           IF I=1

                   SET BIMMR1=$$VNAME^BIUTL2(M)

                   QUIT

 +43           SET BIMMR1="List (Select ""3"" to review list.)"

           End DoDot:1

 +44       SET X="     3 - Immunizations Received...: "_BIMMR1

 +45       DO WRITE(.BILINE,X,1)

 +46       KILL X

 +47      ;

 +48      ;---> Data Elements.

 +49       NEW BIDE1

           SET BIDE1=""

 +50       Begin DoDot:1

 +51           IF '$DATA(BIDE)

                   SET BIDE1="None"

                   QUIT

 +52           IF $DATA(BIDE("ALL"))

                   SET BIDE1="ALL"

                   QUIT

 +53           NEW I,M,N

 +54           SET N=0

 +55           FOR I=0:1

                   SET N=$ORDER(BIDE(N))

                   IF 'N

                       QUIT

                   SET M=N

 +56           IF I=1

                   SET BIDE1=$$DETX^BIUTL6(M)

                   QUIT

 +57           SET BIDE1="List (Select ""4"" to review list.)"

           End DoDot:1

 +58       SET X="     4 - Data Elements............: "_BIDE1

 +59       DO WRITE(.BILINE,X,1)

 +60       KILL X

 +61      ;

 +62      ;---> File Format (1=ASCII,2=HL7,3=ImmServe).

 +63       IF '$GET(BIFMT)

               SET BIFMT=1

 +64       NEW BIFMT1

 +65       SET BIFMT1=$SELECT(BIFMT=2:"HL7",BIFMT=3:"ImmServe",1:"ASCII")

 +66       SET X="     5 - File Format..............: "_BIFMT1

 +67       DO WRITE(.BILINE,X,1)

 +68       KILL X

 +69      ;

 +70      ;---> Output.

 +71       Begin DoDot:1

 +72           IF '$GET(BIOUT)

                   SET BIOUT=0

                   SET BIFLNM=""

                   QUIT

 +73           IF $GET(BIFLNM)=""

                   SET BIOUT=0

           End DoDot:1

 +74       NEW BIOUT1

 +75       SET BIOUT1=$SELECT(BIOUT:"File: "_$GET(BIPATH)_BIFLNM,1:"SCREEN")

 +76       SET X="     6 - Output Device............: "_BIOUT1

 +77       DO WRITE(.BILINE,X)

 +78       KILL X

 +79      ;

 +80      ;---> Finish up Listmanager List Count.

 +81       SET VALMCNT=BILINE

 +82       SET BIRTN="BIEXP1"

 +83       QUIT

 +84      ;

 +85      ;

 +86      ;----------

WRITE(BILINE,BIVAL,BIBLNK) ;EP

 +1       ;---> Write lines to ^TMP (see documentation in ^BIW).

 +2       ;---> Parameters:

 +3       ;     1 - BILINE (ret) Last line# written.

 +4       ;     2 - BIVAL  (opt) Value/text of line (Null=blank line).

 +5       ;     3 - BIBLNK (opt) Number of blank lines to add after line sent.

 +6       ;

 +7        IF '$DATA(BILINE)

               QUIT

 +8        DO WL^BIW(.BILINE,"BIEXP1",$GET(BIVAL),$GET(BIBLNK))

 +9        QUIT

 +10      ;

 +11      ;

 +12      ;----------

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        DO FULL^VALM1

           NEW BIPOP

 +3        DO TITLE^BIUTL5("EXPORT DATA BY INDIVIDUALS - HELP, page 1 of 2")

 +4        DO TEXT1

           DO DIRZ^BIUTL3(.BIPOP)

 +5        IF $GET(BIPOP)

               DO RESET

               QUIT

 +6        DO TITLE^BIUTL5("EXPORT DATA BY INDIVIDUALS - HELP, page 2 of 2")

 +7        DO TEXT2

           DO DIRZ^BIUTL3()

 +8        DO RESET

 +9        QUIT

 +10      ;

 +11      ;

 +12      ;----------

TEXT1     ;

 +1       ;;The EXPORT DATA BY INDIVIDUALS screen provides a menu of options

 +2       ;;for exporting the data of individual patients.

 +3       ;;

 +4       ;;There are 6 items or "parameters" on the screen that you may

 +5       ;;change in order to specify which patients and which data will be

 +6       ;;exported, as well as the output device for the export.

 +7       ;;

 +8       ;;To change an item, enter its left column number (1-6) at the

 +9       ;;prompt on the bottom of the screen.  Use "?" at any prompt where

 +10      ;;you would like help or more information on the parameter you are

 +11      ;;changing.

 +12      ;;

 +13      ;;Once you have the parameters set to retrieve the patients and data

 +14      ;;you want, select E to Export the data.

 +15      ;;

 +16       DO PRINTX("TEXT1")

 +17       QUIT

 +18      ;

 +19      ;

 +20      ;----------

TEXT2     ;EP

 +1       ;;SURVEY DATE: A past or prsent date, after which immunizations

 +2       ;;will not be included in the export.

 +3       ;;

 +4       ;;PATIENTS: Select the patients whose data you wish to export.

 +5       ;;

 +6       ;;VACCINES: If you select for specific Vaccines, only immunizations

 +7       ;;given with the selected vaccines will be included in the export.

 +8       ;;

 +9       ;;DATE ELEMENTS: Select the group of Data Elements you wish to export

 +10      ;;for each immunization.

 +11      ;;

 +12      ;;FILE FORMAT and OUTPUT DEVICE: Detailed help will be given when

 +13      ;;you select these items.

 +14      ;;

 +15       DO PRINTX("TEXT2")

 +16       QUIT

 +17      ;

 +18      ;

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

TEXT3     ;

 +1       ;;                              NOTE

 +2       ;;                             ------

 +3       ;;

 +4       ;;The Quarterly Immunization Report may contain some patients who

 +5       ;;were ACTIVE prior to the Quarter Ending Date you selected, but who

 +6       ;;are now INACTIVE.

 +7       ;;

 +8       ;;The Due List you are about to view will contain only ACTIVE patients

 +9       ;;unless you specify otherwise.

 +10      ;;

 +11      ;;

 +12      ;;

 +13      ;;

 +14      ;;

 +15       DO PRINTX("TEXT3")

 +16       QUIT

 +17      ;

 +18      ;

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

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       ;---> EOJ cleanup.

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

 +3        DO CLEAR^VALM1

 +4        DO FULL^VALM1

 +5        QUIT

BIEXP1.m