Routine: BDGPI0

BDGPI0 ; IHS/ANMC/LJF - PATBDGNT INQUIRY CONTINUED ;

 ;;5.3;PIMS;;APR 26, 2002

SECTION4 ;EP; called by SECTION4^BDGPI

 ; display scheduled visit info

 NEW BDGDT,BDGN,LINE,X

 S BDGDT=$$FMADD^XLFDT(DT,-7)                    ;start up to a week ago

 I '$O(^BDGSV("AD",DFN,BDGDT)) S BDGS=BDGS-1 Q   ;nothing scheduled

 S LINE="("_BDGS_") Scheduled Visits - "

 D SET^BDGPI("",.VALMCNT,BDGS,BDGI),SET^BDGPI(LINE,.VALMCNT,BDGS,BDGI)

 F  S BDGDT=$O(^BDGSV("AD",DFN,BDGDT)) Q:'BDGDT  D

 . S BDGN=0 F  S BDGN=$O(^BDGSV("AD",DFN,BDGDT,BDGN)) Q:'BDGN  D

 .. S LINE="Scheduled "_$$GET1^DIQ(9009016.7,BDGN,.03)   ;visit type

 .. I $$GET1^DIQ(9009016.7,BDGN,.15)="YES" S LINE=LINE_" (SDA)"

 .. S LINE=$$PAD(LINE,26)_" - Expected on "_$$GET1^DIQ(9009016.7,BDGN,.02)

 .. S LINE=LINE_" by "_$$GET1^DIQ(9009016.7,BDGN,.04)  ;auth provider

 .. D SET^BDGPI(LINE,.VALMCNT,BDGS,BDGI)

 .. S X=$$GET1^DIQ(9009016.7,BDGN,.03,"I") I X]"" S X="SV"_X D @X

SVA ; admission specific info

 NEW LINE

 S LINE=$$SP(5)_$$GET1^DIQ(9009016.7,BDGN,.09)                 ;ward

 S LINE=LINE_" / "_$$GET1^DIQ(9009016.7,BDGN,.08)              ;service

 S LINE=LINE_" Expected LOS: "_$$GET1^DIQ(9009016.7,BDGN,.13)  ;los

 S LINE=$$PAD(LINE,50)_$$GET1^DIQ(9009016.7,BDGN,.16)          ;status

 D SET^BDGPI(LINE,.VALMCNT,BDGS,BDGI)

SVD ; day surgery specific info

 NEW LINE

 S LINE=$$SP(5)_"For Surgery on "_$$GET1^DIQ(9009016.7,BDGN,.14)

 S LINE=$$PAD(LINE,30)_$$GET1^DIQ(9009016.7,BDGN,.121)  ;service

 S LINE=$$PAD(LINE,50)_$$GET1^DIQ(9009016.7,BDGN,.16)

 D SET^BDGPI(LINE,.VALMCNT,BDGS,BDGI)

SVO ; outpatient specific info

 NEW LINE

 S LINE=$$SP(5)_$$GET1^DIQ(9009016.7,BDGN,.11)    ;clinic

 S LINE=$$PAD(LINE,50)_$$GET1^DIQ(9009016.7,BDGN,.16)

 D SET^BDGPI(LINE,.VALMCNT,BDGS,BDGI)

SECTION6 ;EP; called by SECTION6^BDGPI

 ; displays incomplete chart status info

 I '$O(^BDGIC("B",DFN)) S BDGS=BDGS-1 Q   ;chart never incomplete

 NEW BDGN,FIRST,LINE

 S BDGN=0,FIRST=1 F  S BDGN=$O(^BDGIC("B",DFN,BDGN)) Q:'BDGN  D

 . I $$GET1^DIQ(9009016.1,BDGN,.14)]"" Q    ;already completed

 . I $$GET1^DIQ(9009016.1,BDGN,.17)]"" Q    ;deleted-entered in error

 . I $$GET1^DIQ(9009016.1,BDGN,.03)="" Q    ;no visit pointer

. ;

 . I FIRST D

 .. S LINE="("_BDGS_") Active Incomplete Chart - "

 .. D SET^BDGPI("",.VALMCNT,BDGS,BDGI)

 .. D SET^BDGPI(LINE,.VALMCNT,BDGS,BDGI)

 .. S FIRST=0

. ;

 . S TYPE=$$GET1^DIQ(9009016.1,BDGN,.0392)

 . S LINE=$$SP(3)_$S(TYPE["DAY":"DAY SURGERY",1:"INPATIENT")_" CHART: "

 . ;  get discharge or surgery date

 . S LINE=LINE_$$GET1^DIQ(9009016.1,BDGN,$S(TYPE["DAY":.05,1:.02))

 . S LINE=$$PAD(LINE,40)_"Service - "

 . ;  get inpatient or surgical service

 . S LINE=LINE_$$GET1^DIQ(9009016.1,BDGN,$S(TYPE["DAY":.06,1:.04))

 . D SET^BDGPI(LINE,.VALMCNT,BDGS,BDGI)

 I FIRST S BDGS=BDGS-1   ;if no active ic charts found

PAD(D,L) ;EP -- SUBRTN to pad length of data

 ; -- D=data L=length

 Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)

SP(N) ; -- SUBRTN to pad N number of spaces

 Q $$PAD(" ",N)

BDGPI0    ; IHS/ANMC/LJF - PATBDGNT INQUIRY CONTINUED ;

 +1       ;;5.3;PIMS;;APR 26, 2002

 +2       ;

SECTION4  ;EP; called by SECTION4^BDGPI

 +1       ; display scheduled visit info

 +2        NEW BDGDT,BDGN,LINE,X

 +3       ;start up to a week ago

           SET BDGDT=$$FMADD^XLFDT(DT,-7)

 +4       ;nothing scheduled

           IF '$ORDER(^BDGSV("AD",DFN,BDGDT))

               SET BDGS=BDGS-1

               QUIT

 +5       ;

 +6        SET LINE="("_BDGS_") Scheduled Visits - "

 +7        DO SET^BDGPI("",.VALMCNT,BDGS,BDGI)

           DO SET^BDGPI(LINE,.VALMCNT,BDGS,BDGI)

 +8       ;

 +9        FOR

               SET BDGDT=$ORDER(^BDGSV("AD",DFN,BDGDT))

               IF 'BDGDT

                   QUIT

               Begin DoDot:1

 +10               SET BDGN=0

FOR

                       SET BDGN=$ORDER(^BDGSV("AD",DFN,BDGDT,BDGN))

                       IF 'BDGN

                           QUIT

                       Begin DoDot:2

 +11      ;visit type

                           SET LINE="Scheduled "_$$GET1^DIQ(9009016.7,BDGN,.03)

 +12                       IF $$GET1^DIQ(9009016.7,BDGN,.15)="YES"

                               SET LINE=LINE_" (SDA)"

 +13                       SET LINE=$$PAD(LINE,26)_" - Expected on "_$$GET1^DIQ(9009016.7,BDGN,.02)

 +14      ;auth provider

                           SET LINE=LINE_" by "_$$GET1^DIQ(9009016.7,BDGN,.04)

 +15                       DO SET^BDGPI(LINE,.VALMCNT,BDGS,BDGI)

 +16                       SET X=$$GET1^DIQ(9009016.7,BDGN,.03,"I")

                           IF X]""

                               SET X="SV"_X

                               DO @X

                       End DoDot:2

               End DoDot:1

 +17       QUIT

 +18      ;

SVA       ; admission specific info

 +1        NEW LINE

 +2       ;ward

           SET LINE=$$SP(5)_$$GET1^DIQ(9009016.7,BDGN,.09)

 +3       ;service

           SET LINE=LINE_" / "_$$GET1^DIQ(9009016.7,BDGN,.08)

 +4       ;los

           SET LINE=LINE_" Expected LOS: "_$$GET1^DIQ(9009016.7,BDGN,.13)

 +5       ;status

           SET LINE=$$PAD(LINE,50)_$$GET1^DIQ(9009016.7,BDGN,.16)

 +6        DO SET^BDGPI(LINE,.VALMCNT,BDGS,BDGI)

 +7        QUIT

 +8       ;

SVD       ; day surgery specific info

 +1        NEW LINE

 +2        SET LINE=$$SP(5)_"For Surgery on "_$$GET1^DIQ(9009016.7,BDGN,.14)

 +3       ;service

           SET LINE=$$PAD(LINE,30)_$$GET1^DIQ(9009016.7,BDGN,.121)

 +4        SET LINE=$$PAD(LINE,50)_$$GET1^DIQ(9009016.7,BDGN,.16)

 +5        DO SET^BDGPI(LINE,.VALMCNT,BDGS,BDGI)

 +6        QUIT

 +7       ;

SVO       ; outpatient specific info

 +1        NEW LINE

 +2       ;clinic

           SET LINE=$$SP(5)_$$GET1^DIQ(9009016.7,BDGN,.11)

 +3        SET LINE=$$PAD(LINE,50)_$$GET1^DIQ(9009016.7,BDGN,.16)

 +4        DO SET^BDGPI(LINE,.VALMCNT,BDGS,BDGI)

 +5        QUIT

 +6       ;

SECTION6  ;EP; called by SECTION6^BDGPI

 +1       ; displays incomplete chart status info

 +2       ;chart never incomplete

           IF '$ORDER(^BDGIC("B",DFN))

               SET BDGS=BDGS-1

               QUIT

 +3       ;

 +4        NEW BDGN,FIRST,LINE

 +5        SET BDGN=0

           SET FIRST=1

FOR

               SET BDGN=$ORDER(^BDGIC("B",DFN,BDGN))

               IF 'BDGN

                   QUIT

               Begin DoDot:1

 +6       ;already completed

                   IF $$GET1^DIQ(9009016.1,BDGN,.14)]""

                       QUIT

 +7       ;deleted-entered in error

                   IF $$GET1^DIQ(9009016.1,BDGN,.17)]""

                       QUIT

 +8       ;no visit pointer

                   IF $$GET1^DIQ(9009016.1,BDGN,.03)=""

                       QUIT

 +9       ;

 +10               IF FIRST

                       Begin DoDot:2

 +11                       SET LINE="("_BDGS_") Active Incomplete Chart - "

 +12                       DO SET^BDGPI("",.VALMCNT,BDGS,BDGI)

 +13                       DO SET^BDGPI(LINE,.VALMCNT,BDGS,BDGI)

 +14                       SET FIRST=0

                       End DoDot:2

 +15      ;

 +16               SET TYPE=$$GET1^DIQ(9009016.1,BDGN,.0392)

 +17               SET LINE=$$SP(3)_$SELECT(TYPE["DAY":"DAY SURGERY",1:"INPATIENT")_" CHART: "

 +18      ;  get discharge or surgery date

 +19               SET LINE=LINE_$$GET1^DIQ(9009016.1,BDGN,$SELECT(TYPE["DAY":.05,1:.02))

 +20               SET LINE=$$PAD(LINE,40)_"Service - "

 +21      ;  get inpatient or surgical service

 +22               SET LINE=LINE_$$GET1^DIQ(9009016.1,BDGN,$SELECT(TYPE["DAY":.06,1:.04))

 +23               DO SET^BDGPI(LINE,.VALMCNT,BDGS,BDGI)

               End DoDot:1

 +24      ;

 +25      ;if no active ic charts found

           IF FIRST

               SET BDGS=BDGS-1

 +26       QUIT

 +27      ;

PAD(D,L)  ;EP -- SUBRTN to pad length of data

 +1       ; -- D=data L=length

 +2        QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)

 +3       ;

SP(N)     ; -- SUBRTN to pad N number of spaces

 +1        QUIT $$PAD(" ",N)

BDGPI0.m