BDGPV1.m

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       ;