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 ;
