BSDAL0.m

BSDAL0 ; IHS/ANMC/LJF - IHS APPT LIST - CONTINUED ; 

 ;;5.3;PIMS;;APR 26, 2002

 ;IHS version of SDAL0

 ;

START ;EP; called by list template INIT^BSDALL

 NEW SC,BSDCN

 S BSDCN=0

 F  S BSDCN=$S(VAUTC:$O(^SC("B",BSDCN)),1:$O(VAUTC(BSDCN))) Q:BSDCN=""  D

 . S SC=0

 . F  S SC=$O(^SC("B",BSDCN,SC)) Q:'SC  D CLINIC

 Q

 ;

CLINIC ; called for each clinic

 NEW BSDACT,BSD,IEN,FIRST

 ; check if clinic is active and not cancelled for date

 I $$CHECK(SC,BSDD),$$ACTIVITY(SC,BSDD) D

 . W !

 . I $G(BSDION)]"" W "@@@@@"  ;top of page marker for paper print

 . W "Appointments for  ",$$GET1^DIQ(44,SC,.01)," clinic on  ",$$FMTE^XLFDT(BSDD)

 . I $G(BSDION)="" W !,$$REPEAT^XLFSTR("=",80)

 . ;

 . ;get each appt time for date and clinic

 . S BSDACT=0,BSD=BSDD

 . F  S BSD=$O(^SC(SC,"S",BSD)) Q:'BSD!(BSD\1>BSDD)  D

 .. ;  find each appt at date/time then call APPTLN to print info

 .. S IEN=0,FIRST=1

 .. F  S IEN=$O(^SC(SC,"S",BSD,1,IEN)) Q:'IEN  D

 ... Q:$P($G(^SC(SC,"S",BSD,1,IEN,0)),U,9)="C"     ;cancelled

 ... D APPTLN(SC,BSD,IEN)                          ;print appt data line

 . ;

 . I 'BSDACT D

 .. S BSDACT="No appointment activity found for this clinic date!"

 .. W !!?(IOM-$L(BSDACT)\2),BSDACT

 . ;

 . W ! I BSDCR D CCLK(SC,BSDD)   ;print chart requests at end of list

 ;

 Q

 ;

APPTLN(CLN,DATE,IEN) ; -- for each individual appt, print patient data

 NEW NODE,DFN,BSDOI,DATA,X,VA,VADM,BSDZ,SPACE,Z,VAPA

 S NODE=^SC(CLN,"S",DATE,1,IEN,0),DFN=+NODE,BSDOI=$P(NODE,U,4)

 I BSDWI=0,$$WALKIN^BSDU2(DFN,DATE) Q    ;quit if excluding walk-ins

 S DATA=$G(^DPT(DFN,"S",DATE,0)) Q:$P(DATA,U,2)["C"   ;cancelled

 D DEM^VADPT

 ;

 ; -- build display line

 ;

 ; line 1: appt time, walkin, checkin, out vs inpt

 I FIRST S FIRST=0,X=DATE D TM^SDROUT0 W !,$J(X,8)    ;appt time

 I $X>15 W !!

 I $P(DATA,U,7)=4 W ?12,"Walk-in "                    ;walk-in

 E  S X=$P($G(^SC(SC,"S",DATE,1,IEN,"C")),U) I X]"" D

 . D TM^SDROUT0 W ?12,"Checked in at ",X              ;checkin time

 I ($P(DATA,U,2)="N")!($P(DATA,U,2)="NA") W ?12,"No-Show"  ;no-show

 S X=$$INPT1^BDGF1(DFN,DATE)                          ;inpatient?

 I X]"" W ?40,"Admitted "_X_"  "                      ;admit date

 W ?40,"(",$S($G(^DPT(DFN,.1))]"":^(.1),1:"Outpatient"),")"

 ;

 ; -- line 2: name, chart #, dob, age, lab/x-ray/ekg times

 I $$DEAD^BDGF2(DFN) W !?12,"** PATIENT DIED ON ",$$DOD^BDGF2(DFN)," **"

 ;

 W !?5,$S($D(^SC(SC,"S",DATE,1,IEN,"OB")):"*",1:"")   ;* if overbook

 W ?7,$E(VADM(1),1,18)                               ;patient name

 W ?30,"#",VA("PID")                                  ;pat id

 W ?39,$$FMTE^XLFDT(+VADM(3),5)," (",VADM(4),")"      ;dob(age)

 ;

 S (BSDZ(3),BSDZ(4),BSDZ(5))=""                       ;lab/xray/ekg

 F X=3,4,5 S BSDZ(X)=$P(DATA,U,X)                     ;test date/times

 S SPACE=0 F Z=3,4,5 S X=BSDZ(Z) D:X]"" TM^SDROUT0 S SPACE=Z#3*8+3 W ?48+SPACE,$J(X,8) W:SPACE<16 "  "

 ;

 ; line 3: insurance coverage and other info

 W !?9,$$INSUR^BDGF2(DFN,DATE) W:BSDOI]"" ?18,BSDOI

 ;

 ; line 4: patient phone and apt made by

 I BSDPH!BSDAMB W !

 I BSDPH K VAPA D ADD^VADPT W ?5,"Phone: ",VAPA(8)    ;pat home phone

 I BSDAMB D                                           ;appt made by

 . NEW X,Y,Z

 . S X=$P(NODE,U,6),Y=$P(NODE,U,7) Q:X=""

 . W ?25,"Made by ",$$GET1^DIQ(200,X,.01),"  on ",$$FMTE^XLFDT(Y,"2")

 . S Z=$$GET1^DIQ(200,X,.132) W:Z]"" ?63," (",Z,")"  ;user's phone

 ;

 ; line 5: primary care provider info

 NEW BSDARR,I

 I BSDPCMM S BSDARR="BSDARR" D PCP^BSDU1(DFN,.BSDARR)

 I $D(BSDARR(1))  W !?20,"PCP: ",$P(BSDARR(1),"/",1,2)

 ;

 S BSDACT=BSDACT+1 W !

 Q

 ;

 ;

CCLK(CLN,DATE) ; -- list chart requests for this clinic and date

 NEW BSDC,DFN,IEN,BSDN

 I $O(^SC(CLN,"C",DATE,1,0)) W !,"CHART REQUESTS for ",$$FMTE^XLFDT(DATE),":"

 S IEN=0 F  S IEN=$O(^SC(CLN,"C",DATE,1,IEN)) Q:'IEN  D

 . S DFN=$G(^SC(CLN,"C",DATE,1,IEN,0)) Q:'DFN

 . S BSDN=$G(^SC(CLN,"C",DATE,1,IEN,9999999))

 . W !,$E($$GET1^DIQ(2,DFN,.01),1,20)

 . W ?23,"#",$$HRCN^BDGF2(DFN,DUZ(2))

 . W ?35,$E($P(BSDN,U,3),1,33)

 . Q:'BSDAMB

 . W !?35,"Made by ",$E($$GET1^DIQ(200,+$P(BSDN,U,2),.01),1,15)

 . W " on ",$$FMTE^XLFDT(+BSDN,"D")

 Q

 ;

 ;

CHECK(CLN,APDT) ;check if clinic for this division and not cancelled or inactive

 I $$GET1^DIQ(44,CLN,2,"I")'="C" Q 0                   ;not a clinic

 I 'VAUTD,'$D(VAUTD(+$$GET1^DIQ(44,CLN,3.5,"I"))) Q 0  ;wrong division

 I '$$ACTV^BSDU(CLN,APDT) Q 0                          ;not active

 I $G(^SC(CLN,"ST",APDT,1))="" Q 0                     ;no schedule

 I $G(^SC(CLN,"ST",APDT,1))["**CANCELLED" Q 0          ;cancelled

 Q 1

 ;

 ;

ACTIVITY(CLN,APDT) ;Determine if clinic has activity to print for appt date

 I BSDCR,$O(^SC(CLN,"C",APDT,0)) Q 1  ;chart request list

 NEW DATE,FOUND,N

 S FOUND=0,DATE=APDT

 F  S DATE=$O(^SC(CLN,"S",DATE)) Q:'DATE  Q:(DATE\1>APDT)  Q:FOUND  D

 .S N=0 F  S N=$O(^SC(CLN,"S",DATE,1,N)) Q:'N!FOUND  D

 .. I $P(^SC(CLN,"S",DATE,1,N,0),U,9)'["C" S FOUND=1

 Q FOUND

 ;

BSDAL0    ; IHS/ANMC/LJF - IHS APPT LIST - CONTINUED ; 

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

 +2       ;IHS version of SDAL0

 +3       ;

START     ;EP; called by list template INIT^BSDALL

 +1        NEW SC,BSDCN

 +2        SET BSDCN=0

 +3        FOR 

               SET BSDCN=$SELECT(VAUTC:$ORDER(^SC("B",BSDCN)),1:$ORDER(VAUTC(BSDCN)))

               IF BSDCN=""

                   QUIT 

               Begin DoDot:1

 +4                SET SC=0

 +5                FOR 

                       SET SC=$ORDER(^SC("B",BSDCN,SC))

                       IF 'SC

                           QUIT 

                       DO CLINIC

               End DoDot:1

 +6        QUIT 

 +7       ;

CLINIC    ; called for each clinic

 +1        NEW BSDACT,BSD,IEN,FIRST

 +2       ; check if clinic is active and not cancelled for date

 +3        IF $$CHECK(SC,BSDD)

               IF $$ACTIVITY(SC,BSDD)

                   Begin DoDot:1

 +4                    WRITE !

 +5       ;top of page marker for paper print

                       IF $GET(BSDION)]""

                           WRITE "@@@@@"

 +6                    WRITE "Appointments for  ",$$GET1^DIQ(44,SC,.01)," clinic on  ",$$FMTE^XLFDT(BSDD)

 +7                    IF $GET(BSDION)=""

                           WRITE !,$$REPEAT^XLFSTR("=",80)

 +8       ;

 +9       ;get each appt time for date and clinic

 +10                   SET BSDACT=0

                       SET BSD=BSDD

 +11                   FOR 

                           SET BSD=$ORDER(^SC(SC,"S",BSD))

                           IF 'BSD!(BSD\1>BSDD)

                               QUIT 

                           Begin DoDot:2

 +12      ;  find each appt at date/time then call APPTLN to print info

 +13                           SET IEN=0

                               SET FIRST=1

 +14                           FOR 

                                   SET IEN=$ORDER(^SC(SC,"S",BSD,1,IEN))

                                   IF 'IEN

                                       QUIT 

                                   Begin DoDot:3

 +15      ;cancelled

                                       IF $PIECE($GET(^SC(SC,"S",BSD,1,IEN,0)),U,9)="C"

                                           QUIT 

 +16      ;print appt data line

                                       DO APPTLN(SC,BSD,IEN)

                                   End DoDot:3

                           End DoDot:2

 +17      ;

 +18                   IF 'BSDACT

                           Begin DoDot:2

 +19                           SET BSDACT="No appointment activity found for this clinic date!"

 +20                           WRITE !!?(IOM-$LENGTH(BSDACT)\2),BSDACT

                           End DoDot:2

 +21      ;

 +22      ;print chart requests at end of list

                       WRITE !

                       IF BSDCR

                           DO CCLK(SC,BSDD)

                   End DoDot:1

 +23      ;

 +24       QUIT 

 +25      ;

APPTLN(CLN,DATE,IEN) ; -- for each individual appt, print patient data

 +1        NEW NODE,DFN,BSDOI,DATA,X,VA,VADM,BSDZ,SPACE,Z,VAPA

 +2        SET NODE=^SC(CLN,"S",DATE,1,IEN,0)

           SET DFN=+NODE

           SET BSDOI=$PIECE(NODE,U,4)

 +3       ;quit if excluding walk-ins

           IF BSDWI=0

               IF $$WALKIN^BSDU2(DFN,DATE)

                   QUIT 

 +4       ;cancelled

           SET DATA=$GET(^DPT(DFN,"S",DATE,0))

           IF $PIECE(DATA,U,2)["C"

               QUIT 

 +5        DO DEM^VADPT

 +6       ;

 +7       ; -- build display line

 +8       ;

 +9       ; line 1: appt time, walkin, checkin, out vs inpt

 +10      ;appt time

           IF FIRST

               SET FIRST=0

               SET X=DATE

               DO TM^SDROUT0

               WRITE !,$JUSTIFY(X,8)

 +11       IF $X>15

               WRITE !!

 +12      ;walk-in

           IF $PIECE(DATA,U,7)=4

               WRITE ?12,"Walk-in "

 +13      IF '$TEST

               SET X=$PIECE($GET(^SC(SC,"S",DATE,1,IEN,"C")),U)

               IF X]""

                   Begin DoDot:1

 +14      ;checkin time

                       DO TM^SDROUT0

                       WRITE ?12,"Checked in at ",X

                   End DoDot:1

 +15      ;no-show

           IF ($PIECE(DATA,U,2)="N")!($PIECE(DATA,U,2)="NA")

               WRITE ?12,"No-Show"

 +16      ;inpatient?

           SET X=$$INPT1^BDGF1(DFN,DATE)

 +17      ;admit date

           IF X]""

               WRITE ?40,"Admitted "_X_"  "

 +18       WRITE ?40,"(",$SELECT($GET(^DPT(DFN,.1))]"":^(.1),1:"Outpatient"),")"

 +19      ;

 +20      ; -- line 2: name, chart #, dob, age, lab/x-ray/ekg times

 +21       IF $$DEAD^BDGF2(DFN)

               WRITE !?12,"** PATIENT DIED ON ",$$DOD^BDGF2(DFN)," **"

 +22      ;

 +23      ;* if overbook

           WRITE !?5,$SELECT($DATA(^SC(SC,"S",DATE,1,IEN,"OB")):"*",1:"")

 +24      ;patient name

           WRITE ?7,$EXTRACT(VADM(1),1,18)

 +25      ;pat id

           WRITE ?30,"#",VA("PID")

 +26      ;dob(age)

           WRITE ?39,$$FMTE^XLFDT(+VADM(3),5)," (",VADM(4),")"

 +27      ;

 +28      ;lab/xray/ekg

           SET (BSDZ(3),BSDZ(4),BSDZ(5))=""

 +29      ;test date/times

           FOR X=3,4,5

               SET BSDZ(X)=$PIECE(DATA,U,X)

 +30       SET SPACE=0

           FOR Z=3,4,5

               SET X=BSDZ(Z)

               IF X]""

                   DO TM^SDROUT0

               SET SPACE=Z#3*8+3

               WRITE ?48+SPACE,$JUSTIFY(X,8)

               IF SPACE<16

                   WRITE "  "

 +31      ;

 +32      ; line 3: insurance coverage and other info

 +33       WRITE !?9,$$INSUR^BDGF2(DFN,DATE)

           IF BSDOI]""

               WRITE ?18,BSDOI

 +34      ;

 +35      ; line 4: patient phone and apt made by

 +36       IF BSDPH!BSDAMB

               WRITE !

 +37      ;pat home phone

           IF BSDPH

               KILL VAPA

               DO ADD^VADPT

               WRITE ?5,"Phone: ",VAPA(8)

 +38      ;appt made by

           IF BSDAMB

               Begin DoDot:1

 +39               NEW X,Y,Z

 +40               SET X=$PIECE(NODE,U,6)

                   SET Y=$PIECE(NODE,U,7)

                   IF X=""

                       QUIT 

 +41               WRITE ?25,"Made by ",$$GET1^DIQ(200,X,.01),"  on ",$$FMTE^XLFDT(Y,"2")

 +42      ;user's phone

                   SET Z=$$GET1^DIQ(200,X,.132)

                   IF Z]""

                       WRITE ?63," (",Z,")"

               End DoDot:1

 +43      ;

 +44      ; line 5: primary care provider info

 +45       NEW BSDARR,I

 +46       IF BSDPCMM

               SET BSDARR="BSDARR"

               DO PCP^BSDU1(DFN,.BSDARR)

 +47       IF $DATA(BSDARR(1))

               WRITE !?20,"PCP: ",$PIECE(BSDARR(1),"/",1,2)

 +48      ;

 +49       SET BSDACT=BSDACT+1

           WRITE !

 +50       QUIT 

 +51      ;

 +52      ;

CCLK(CLN,DATE) ; -- list chart requests for this clinic and date

 +1        NEW BSDC,DFN,IEN,BSDN

 +2        IF $ORDER(^SC(CLN,"C",DATE,1,0))

               WRITE !,"CHART REQUESTS for ",$$FMTE^XLFDT(DATE),":"

 +3        SET IEN=0

           FOR 

               SET IEN=$ORDER(^SC(CLN,"C",DATE,1,IEN))

               IF 'IEN

                   QUIT 

               Begin DoDot:1

 +4                SET DFN=$GET(^SC(CLN,"C",DATE,1,IEN,0))

                   IF 'DFN

                       QUIT 

 +5                SET BSDN=$GET(^SC(CLN,"C",DATE,1,IEN,9999999))

 +6                WRITE !,$EXTRACT($$GET1^DIQ(2,DFN,.01),1,20)

 +7                WRITE ?23,"#",$$HRCN^BDGF2(DFN,DUZ(2))

 +8                WRITE ?35,$EXTRACT($PIECE(BSDN,U,3),1,33)

 +9                IF 'BSDAMB

                       QUIT 

 +10               WRITE !?35,"Made by ",$EXTRACT($$GET1^DIQ(200,+$PIECE(BSDN,U,2),.01),1,15)

 +11               WRITE " on ",$$FMTE^XLFDT(+BSDN,"D")

               End DoDot:1

 +12       QUIT 

 +13      ;

 +14      ;

CHECK(CLN,APDT) ;check if clinic for this division and not cancelled or inactive

 +1       ;not a clinic

           IF $$GET1^DIQ(44,CLN,2,"I")'="C"

               QUIT 0

 +2       ;wrong division

           IF 'VAUTD

               IF '$DATA(VAUTD(+$$GET1^DIQ(44,CLN,3.5,"I")))

                   QUIT 0

 +3       ;not active

           IF '$$ACTV^BSDU(CLN,APDT)

               QUIT 0

 +4       ;no schedule

           IF $GET(^SC(CLN,"ST",APDT,1))=""

               QUIT 0

 +5       ;cancelled

           IF $GET(^SC(CLN,"ST",APDT,1))["**CANCELLED"

               QUIT 0

 +6        QUIT 1

 +7       ;

 +8       ;

ACTIVITY(CLN,APDT) ;Determine if clinic has activity to print for appt date

 +1       ;chart request list

           IF BSDCR

               IF $ORDER(^SC(CLN,"C",APDT,0))

                   QUIT 1

 +2        NEW DATE,FOUND,N

 +3        SET FOUND=0

           SET DATE=APDT

 +4        FOR 

               SET DATE=$ORDER(^SC(CLN,"S",DATE))

               IF 'DATE

                   QUIT 

               IF (DATE\1>APDT)

                   QUIT 

               IF FOUND

                   QUIT 

               Begin DoDot:1

 +5                SET N=0

                   FOR 

                       SET N=$ORDER(^SC(CLN,"S",DATE,1,N))

                       IF 'N!FOUND

                           QUIT 

                       Begin DoDot:2

 +6                        IF $PIECE(^SC(CLN,"S",DATE,1,N,0),U,9)'["C"

                               SET FOUND=1

                       End DoDot:2

               End DoDot:1

 +7        QUIT FOUND

 +8       ;