- BGP6XTV1 ; IHS/CMI/LAB - DISPLAY IND LISTS ;
- ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
- ;; ;
- 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 TERM^VALM0
- D EN^VALM("BGP 16 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
- ;
- S VALMSG="Select the Appropriate Action Q to Quit"
- 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,"B",BGPX)) Q:BGPX="" D
- .S BGPY=$O(^ATXAX(BGPTAXI,21,"B",BGPX,0)) Q:BGPY'=+BGPY D
- ..S C=C+1
- ..S BGPITMI=$P(^ATXAX(BGPTAXI,21,BGPY,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,"B",BGPX)) Q:BGPX="" D
- .S BGPY=0 F S BGPY=$O(^ATXAX(BGPTAXI,21,"B",BGPX,BGPY)) Q:BGPY="" D
- ..S C=C+1
- ..S BGPITEM(C,0)=C_") "_$P(^ATXAX(BGPTAXI,21,BGPY,0),U)_" through "_$P(^ATXAX(BGPTAXI,21,BGPY,0),U,2) I $P(^ATXAX(BGPTAXI,21,BGPY,0),U,3) S $E(BGPITEM(C,0),40)=$P(^ICDS($P(^ATXAX(BGPTAXI,21,BGPY,0),U,3),0),U,1)
- ..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
- BGP6XTV1 ; IHS/CMI/LAB - DISPLAY IND LISTS ;
- +1 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
- +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 TERM^VALM0
- +2 DO EN^VALM("BGP 16 TAXONOMY VIEW ONE")
- +3 DO CLEAR^VALM1
- +4 DO FULL^VALM1
- +5 IF $DATA(IOF)
- WRITE @IOF
- +6 DO EOJ
- +7 QUIT
- +8 ;
- 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 SET VALMSG="Select the Appropriate Action Q to Quit"
- +3 IF BGPTYPE="L"
- SET BGPFILE=60
- +4 IF BGPTYPE'="L"
- SET BGPFILE=$PIECE(^ATXAX(BGPTAXI,0),U,15)
- +5 IF BGPTYPE="L"
- DO LAB
- QUIT
- +6 IF BGPTYPE="A"!(BGPTYPE="N")
- DO CANDISP
- QUIT
- +7 IF $PIECE(^ATXAX(BGPTAXI,0),U,13)
- DO CANDISP
- QUIT
- +8 KILL BGPITEM
- SET BGPHIGH=""
- SET C=0
- +9 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^ATXAX(BGPTAXI,21,"B",BGPX))
- IF BGPX=""
- QUIT
- Begin DoDot:1
- +10 SET BGPY=$ORDER(^ATXAX(BGPTAXI,21,"B",BGPX,0))
- IF BGPY'=+BGPY
- QUIT
- Begin DoDot:2
- +11 SET C=C+1
- +12 SET BGPITMI=$PIECE(^ATXAX(BGPTAXI,21,BGPY,0),U)
- +13 IF BGPFILE=9999999.05
- SET BGPITEM(C,0)=C_") "_BGPITMI
- IF 1
- +14 IF '$TEST
- SET BGPITEM(C,0)=C_") "_$$VAL^XBDIQ1($PIECE(^ATXAX(BGPTAXI,0),U,15),BGPITMI,.01)
- +15 SET BGPITEM("IDX",C,C)=BGPITMI
- End DoDot:2
- +16 QUIT
- End DoDot:1
- +17 SET (VALMCNT,BGPHIGH)=C
- +18 QUIT
- CANDISP ;
- +1 KILL BGPITEM
- SET BGPHIGH=""
- SET C=0
- +2 SET BGPX=0
- FOR
- SET BGPX=$ORDER(^ATXAX(BGPTAXI,21,"B",BGPX))
- IF BGPX=""
- QUIT
- Begin DoDot:1
- +3 SET BGPY=0
- FOR
- SET BGPY=$ORDER(^ATXAX(BGPTAXI,21,"B",BGPX,BGPY))
- IF BGPY=""
- QUIT
- Begin DoDot:2
- +4 SET C=C+1
- +5 SET BGPITEM(C,0)=C_") "_$PIECE(^ATXAX(BGPTAXI,21,BGPY,0),U)_" through "_$PIECE(^ATXAX(BGPTAXI,21,BGPY,0),U,2)
- IF $PIECE(^ATXAX(BGPTAXI,21,BGPY,0),U,3)
- SET $EXTRACT(BGPITEM(C,0),40)=$PIECE(^ICDS($PIECE(^ATXAX(BGPTAXI,21,BGPY,0),U,3),0),U,1)
- +6 SET BGPITEM("IDX",C,C)=BGPX
- End DoDot:2
- +7 QUIT
- End DoDot:1
- +8 SET (VALMCNT,BGPHIGH)=C
- +9 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
