BGP5TXV1.m

BGP5TXV1 ; IHS/CMI/LAB - DISPLAY IND LISTS ;

 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007

 ;; ;

EP(BGPTAXI,BGPTYPE,BGPFIEN) ;EP - CALLED FROM OPTION

 NEW BGPRPTTT,BGPRPTT1,BGPRPTT2

 D EN

 Q

EOJ ;EP

 D EN^XBVK("BGP")

 Q

 ;; ;

EN ;EP -- main entry point for 

 D EN^VALM("BGP 05 TAXONOMY VIEW ONE")

 D CLEAR^VALM1

 D FULL^VALM1

 W:$D(IOF) @IOF

 D EOJ

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)="Display of the "_$$NAME(BGPTAXI,BGPTYPE)_" taxonomy"

 S VALMHDR(2)="* View Taxonomies"

 Q

 ;

NAME(I,T) ;

 I T="L" Q $P(^ATXLAB(I,0),U)

 I T'="L" Q $P(^ATXAX(I,0),U)

 Q ""

INIT ; -- init variables and list array

 ;

 I BGPTYPE="L" S BGPFILE=60

 I BGPTYPE'="L" S BGPFILE=$P(^ATXAX(BGPTAXI,0),U,15)

 I BGPTYPE="L" D LAB Q

 I BGPTYPE="A"!(BGPTYPE="N") D CANDISP Q

 I $P(^ATXAX(BGPTAXI,0),U,13) D CANDISP Q

 K BGPITEM S BGPHIGH="",C=0

 S BGPX=0 F  S BGPX=$O(^ATXAX(BGPTAXI,21,BGPX)) Q:BGPX'=+BGPX  D

 .S C=C+1

 .S BGPITMI=$P(^ATXAX(BGPTAXI,21,BGPX,0),U)

 .I BGPFILE=9999999.05 S BGPITEM(C,0)=C_")  "_BGPITMI I 1

 .E  S BGPITEM(C,0)=C_")  "_$$VAL^XBDIQ1($P(^ATXAX(BGPTAXI,0),U,15),BGPITMI,.01)

 .S BGPITEM("IDX",C,C)=BGPITMI

 .Q

 S (VALMCNT,BGPHIGH)=C

 Q

CANDISP ;

 K BGPITEM S BGPHIGH="",C=0

 S BGPX=0 F  S BGPX=$O(^ATXAX(BGPTAXI,21,BGPX)) Q:BGPX'=+BGPX  D

 .S C=C+1

 .S BGPITEM(C,0)=C_")  "_$P(^ATXAX(BGPTAXI,21,BGPX,0),U)_" through  "_$P(^ATXAX(BGPTAXI,21,BGPX,0),U,2)

 .S BGPITEM("IDX",C,C)=BGPX

 .Q

 S (VALMCNT,BGPHIGH)=C

 Q

LAB ;

 K BGPITEM S BGPHIGH="",C=0

 S BGPX=0 F  S BGPX=$O(^ATXLAB(BGPTAXI,21,BGPX)) Q:BGPX'=+BGPX  D

 .S C=C+1

 .S BGPITMI=$P(^ATXLAB(BGPTAXI,21,BGPX,0),U)

 .S BGPITEM(C,0)=C_")  "_$P($G(^LAB(60,BGPITMI,0)),U)

 .S BGPITEM("IDX",C,C)=BGPITMI

 .Q

 S (VALMCNT,BGPHIGH)=C

 Q

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 Q

 ;

EXPND ; -- expand code

 Q

 ;

BACK ;go back to listman

 D TERM^VALM0

 S VALMBCK="R"

 D INIT

 D HDR

 K DIR

 K X,Y,Z,I

 Q

BGP5TXV1  ; IHS/CMI/LAB - DISPLAY IND LISTS ;

 +1       ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007

 +2       ;; ;

EP(BGPTAXI,BGPTYPE,BGPFIEN) ;EP - CALLED FROM OPTION

 +1        NEW BGPRPTTT,BGPRPTT1,BGPRPTT2

 +2        DO EN

 +3        QUIT 

EOJ       ;EP

 +1        DO EN^XBVK("BGP")

 +2        QUIT 

 +3       ;; ;

EN        ;EP -- main entry point for 

 +1        DO EN^VALM("BGP 05 TAXONOMY VIEW ONE")

 +2        DO CLEAR^VALM1

 +3        DO FULL^VALM1

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        DO EOJ

 +6        QUIT 

 +7       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)="Display of the "_$$NAME(BGPTAXI,BGPTYPE)_" taxonomy"

 +2        SET VALMHDR(2)="* View Taxonomies"

 +3        QUIT 

 +4       ;

NAME(I,T) ;

 +1        IF T="L"

               QUIT $PIECE(^ATXLAB(I,0),U)

 +2        IF T'="L"

               QUIT $PIECE(^ATXAX(I,0),U)

 +3        QUIT ""

INIT      ; -- init variables and list array

 +1       ;

 +2        IF BGPTYPE="L"

               SET BGPFILE=60

 +3        IF BGPTYPE'="L"

               SET BGPFILE=$PIECE(^ATXAX(BGPTAXI,0),U,15)

 +4        IF BGPTYPE="L"

               DO LAB

               QUIT 

 +5        IF BGPTYPE="A"!(BGPTYPE="N")

               DO CANDISP

               QUIT 

 +6        IF $PIECE(^ATXAX(BGPTAXI,0),U,13)

               DO CANDISP

               QUIT 

 +7        KILL BGPITEM

           SET BGPHIGH=""

           SET C=0

 +8        SET BGPX=0

           FOR 

               SET BGPX=$ORDER(^ATXAX(BGPTAXI,21,BGPX))

               IF BGPX'=+BGPX

                   QUIT 

               Begin DoDot:1

 +9                SET C=C+1

 +10               SET BGPITMI=$PIECE(^ATXAX(BGPTAXI,21,BGPX,0),U)

 +11               IF BGPFILE=9999999.05

                       SET BGPITEM(C,0)=C_")  "_BGPITMI

                       IF 1

 +12              IF '$TEST

                       SET BGPITEM(C,0)=C_")  "_$$VAL^XBDIQ1($PIECE(^ATXAX(BGPTAXI,0),U,15),BGPITMI,.01)

 +13               SET BGPITEM("IDX",C,C)=BGPITMI

 +14               QUIT 

               End DoDot:1

 +15       SET (VALMCNT,BGPHIGH)=C

 +16       QUIT 

CANDISP   ;

 +1        KILL BGPITEM

           SET BGPHIGH=""

           SET C=0

 +2        SET BGPX=0

           FOR 

               SET BGPX=$ORDER(^ATXAX(BGPTAXI,21,BGPX))

               IF BGPX'=+BGPX

                   QUIT 

               Begin DoDot:1

 +3                SET C=C+1

 +4                SET BGPITEM(C,0)=C_")  "_$PIECE(^ATXAX(BGPTAXI,21,BGPX,0),U)_" through  "_$PIECE(^ATXAX(BGPTAXI,21,BGPX,0),U,2)

 +5                SET BGPITEM("IDX",C,C)=BGPX

 +6                QUIT 

               End DoDot:1

 +7        SET (VALMCNT,BGPHIGH)=C

 +8        QUIT 

LAB       ;

 +1        KILL BGPITEM

           SET BGPHIGH=""

           SET C=0

 +2        SET BGPX=0

           FOR 

               SET BGPX=$ORDER(^ATXLAB(BGPTAXI,21,BGPX))

               IF BGPX'=+BGPX

                   QUIT 

               Begin DoDot:1

 +3                SET C=C+1

 +4                SET BGPITMI=$PIECE(^ATXLAB(BGPTAXI,21,BGPX,0),U)

 +5                SET BGPITEM(C,0)=C_")  "_$PIECE($GET(^LAB(60,BGPITMI,0)),U)

 +6                SET BGPITEM("IDX",C,C)=BGPITMI

 +7                QUIT 

               End DoDot:1

 +8        SET (VALMCNT,BGPHIGH)=C

 +9        QUIT 

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        QUIT 

 +2       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

BACK      ;go back to listman

 +1        DO TERM^VALM0

 +2        SET VALMBCK="R"

 +3        DO INIT

 +4        DO HDR

 +5        KILL DIR

 +6        KILL X,Y,Z,I

 +7        QUIT