- BDGPV1 ; IHS/ANMC/LJF - PROVIDER INQUIRY CONT. ;
- ;;5.3;PIMS;**1003**;MAY 28, 2004
- ;IHS/ITSC/LJF 05/13/2005 PATCH 1003 added code to view day surgeries
- ;
- CWAD ;EP; code to display CWAD info
- NEW BDGN,DFN
- D GETITEM I BDGN="" D RETURN Q
- S DFN=$P(BDGN,U,2)
- I $L($T(CWAD^TIULX)) D CWAD^TIULX
- D RETURN
- Q
- ;
- EXPND ;EP; code to expand on entries shown
- NEW BDGN
- D GETITEM I BDGN="" D RETURN Q
- S X=$P(BDGN,U) D @X D RETURN
- Q
- ;
- IP ; expand inpatient entries
- NEW DFN,DGPMCA
- S DFN=$P(BDGN,U,2),DGPMCA=$P(BDGN,U,3)
- D EN^BDGEPI
- Q
- ;
- SR ; expand va surgery entries
- I $T(VIEW^BSRLA0)="" Q ;routine not available
- NEW SRDR
- S SRDR=$P(BDGN,U,2) I '$D(^SRF(+SRDR)) Q
- D VIEW^BSRLA0,PAUSE^BDGF
- Q
- ;
- DS ;expand day surgery file entries
- D EN^BDGPI3("",$P(BDGN,U,3),$P(BDGN,U,2)) ;IHS/ITSC/LJF 5/13/2005 PATCH 1003
- Q
- ;
- OP ; expand appts
- NEW DFN,SDCL,SDT,SDW
- S DFN=$P(BDGN,U,2),SDCL=$P(BDGN,U,3),SDT=$P(BDGN,U,4),SDW=$P(BDGN,U,5)
- I (DFN="")!(SDCL="")!(SDT="")!(SDW="") Q
- D EN^BSDAMEP
- Q
- ;
- GETITEM ; -- select entry from list
- NEW X,Y,Z
- D FULL^VALM1
- S BDGN=""
- D EN^VALM2(XQORNOD(0),"OS")
- I '$D(VALMY) Q
- S X=$O(VALMY(0))
- S Y=0 F S Y=$O(^TMP("BDGPV",$J,"IDX",Y)) Q:Y="" Q:BDGN]"" D
- . S Z=0 F S Z=$O(^TMP("BDGPV",$J,"IDX",Y,Z)) Q:'Z Q:BDGN]"" D
- .. Q:^TMP("BDGPV",$J,"IDX",Y,Z)=""
- .. I Z=X S BDGN=^TMP("BDGPV",$J,"IDX",Y,Z)_U_X
- Q
- ;
- RETURN ; return to higher level list template
- D TERM^VALM0 S VALMBCK="R" Q
- ;
- BDGPV1 ; IHS/ANMC/LJF - PROVIDER INQUIRY CONT. ;
- +1 ;;5.3;PIMS;**1003**;MAY 28, 2004
- +2 ;IHS/ITSC/LJF 05/13/2005 PATCH 1003 added code to view day surgeries
- +3 ;
- CWAD ;EP; code to display CWAD info
- +1 NEW BDGN,DFN
- +2 DO GETITEM
- IF BDGN=""
- DO RETURN
- QUIT
- +3 SET DFN=$PIECE(BDGN,U,2)
- +4 IF $LENGTH($TEXT(CWAD^TIULX))
- DO CWAD^TIULX
- +5 DO RETURN
- +6 QUIT
- +7 ;
- EXPND ;EP; code to expand on entries shown
- +1 NEW BDGN
- +2 DO GETITEM
- IF BDGN=""
- DO RETURN
- QUIT
- +3 SET X=$PIECE(BDGN,U)
- DO @X
- DO RETURN
- +4 QUIT
- +5 ;
- IP ; expand inpatient entries
- +1 NEW DFN,DGPMCA
- +2 SET DFN=$PIECE(BDGN,U,2)
- SET DGPMCA=$PIECE(BDGN,U,3)
- +3 DO EN^BDGEPI
- +4 QUIT
- +5 ;
- SR ; expand va surgery entries
- +1 ;routine not available
- IF $TEXT(VIEW^BSRLA0)=""
- QUIT
- +2 NEW SRDR
- +3 SET SRDR=$PIECE(BDGN,U,2)
- IF '$DATA(^SRF(+SRDR))
- QUIT
- +4 DO VIEW^BSRLA0
- DO PAUSE^BDGF
- +5 QUIT
- +6 ;
- DS ;expand day surgery file entries
- +1 ;IHS/ITSC/LJF 5/13/2005 PATCH 1003
- DO EN^BDGPI3("",$PIECE(BDGN,U,3),$PIECE(BDGN,U,2))
- +2 QUIT
- +3 ;
- OP ; expand appts
- +1 NEW DFN,SDCL,SDT,SDW
- +2 SET DFN=$PIECE(BDGN,U,2)
- SET SDCL=$PIECE(BDGN,U,3)
- SET SDT=$PIECE(BDGN,U,4)
- SET SDW=$PIECE(BDGN,U,5)
- +3 IF (DFN="")!(SDCL="")!(SDT="")!(SDW="")
- QUIT
- +4 DO EN^BSDAMEP
- +5 QUIT
- +6 ;
- GETITEM ; -- select entry from list
- +1 NEW X,Y,Z
- +2 DO FULL^VALM1
- +3 SET BDGN=""
- +4 DO EN^VALM2(XQORNOD(0),"OS")
- +5 IF '$DATA(VALMY)
- QUIT
- +6 SET X=$ORDER(VALMY(0))
- +7 SET Y=0
- FOR
- SET Y=$ORDER(^TMP("BDGPV",$JOB,"IDX",Y))
- IF Y=""
- QUIT
- IF BDGN]""
- QUIT
- Begin DoDot:1
- +8 SET Z=0
- FOR
- SET Z=$ORDER(^TMP("BDGPV",$JOB,"IDX",Y,Z))
- IF 'Z
- QUIT
- IF BDGN]""
- QUIT
- Begin DoDot:2
- +9 IF ^TMP("BDGPV",$JOB,"IDX",Y,Z)=""
- QUIT
- +10 IF Z=X
- SET BDGN=^TMP("BDGPV",$JOB,"IDX",Y,Z)_U_X
- End DoDot:2
- End DoDot:1
- +11 QUIT
- +12 ;
- RETURN ; return to higher level list template
- +1 DO TERM^VALM0
- SET VALMBCK="R"
- QUIT
- +2 ;
