- BSDAL1 ; IHS/ANMC/LJF - IHS APPOINTMENT LIST ;
- ;;5.3;PIMS;**1011**;APR 26, 2002
- ;Appt List where clinic is already known
- ;
- ;cmi/flag/maw 11/6/2008 added set of BSDD(1) for appointment list
- ;
- ;
- LIST(SC,TYPE) ;EP -- list appointments; called by Month-at-a-glance
- NEW A,ALL,DFN,DIC,I,INC,K,M,PCNT,POP,PT,SD,SD1,SDB,SDCC,SDCP,SDD
- NEW SDEM1,SDDIF,SDDIF1,SDEA,SDEC,SDEDT,SDEM,SDEND,SDFL,SDFS,SDIN
- NEW SDNT,SDOI,SDPD,SDREV,SDT,SDTT,SDX,SDXX,SDZ,VADAT,VADATE,VAUTC
- NEW VAUTD,VAQK,X,Y,Y1,Y2,Z
- Q:'$G(SC) Q:'$G(TYPE) Q:TYPE<1 Q:TYPE>2
- S VAUTC=0,VAUTD=0,VAUTC($P(^SC(SC,0),U))=SC,M=1
- S X=$P($G(^SC(+SC,0)),U,15),VAUTD(X)=$P(^DG(40.8,+X,0),U)
- K DIC("S") S %DT("A")="List Appointments For Which Date: ",%DT="AEXF"
- D ^%DT K %DT,% I (X["^")!(Y<0) Q
- ;
- I TYPE=1 S BSDD=Y,BSDD(1)=Y D Q ;long appt list
- . NEW BSDWI,BSDPCMM,BSDAMB,BSDPH,BSDCR
- . S BSDWI=1,BSDCR=0,BSDPCMM=1,BSDAMB=1,BSDPH=0
- . I $$GET1^DIQ(9009020.2,$$DIV^BSDU,.12)="YES",'$D(^XUSEC("SDZSUP",DUZ)) S BSDAMB=0 ;facility restricts seeing who made appt
- . D EN^BSDALL
- ;
- I TYPE=2 D EN^BSDALS(SC,Y) Q ;short appt list
- BSDAL1 ; IHS/ANMC/LJF - IHS APPOINTMENT LIST ;
- +1 ;;5.3;PIMS;**1011**;APR 26, 2002
- +2 ;Appt List where clinic is already known
- +3 ;
- +4 ;cmi/flag/maw 11/6/2008 added set of BSDD(1) for appointment list
- +5 ;
- +6 ;
- LIST(SC,TYPE) ;EP -- list appointments; called by Month-at-a-glance
- +1 NEW A,ALL,DFN,DIC,I,INC,K,M,PCNT,POP,PT,SD,SD1,SDB,SDCC,SDCP,SDD
- +2 NEW SDEM1,SDDIF,SDDIF1,SDEA,SDEC,SDEDT,SDEM,SDEND,SDFL,SDFS,SDIN
- +3 NEW SDNT,SDOI,SDPD,SDREV,SDT,SDTT,SDX,SDXX,SDZ,VADAT,VADATE,VAUTC
- +4 NEW VAUTD,VAQK,X,Y,Y1,Y2,Z
- +5 IF '$GET(SC)
- QUIT
- IF '$GET(TYPE)
- QUIT
- IF TYPE<1
- QUIT
- IF TYPE>2
- QUIT
- +6 SET VAUTC=0
- SET VAUTD=0
- SET VAUTC($PIECE(^SC(SC,0),U))=SC
- SET M=1
- +7 SET X=$PIECE($GET(^SC(+SC,0)),U,15)
- SET VAUTD(X)=$PIECE(^DG(40.8,+X,0),U)
- +8 KILL DIC("S")
- SET %DT("A")="List Appointments For Which Date: "
- SET %DT="AEXF"
- +9 DO ^%DT
- KILL %DT,%
- IF (X["^")!(Y<0)
- QUIT
- +10 ;
- +11 ;long appt list
- IF TYPE=1
- SET BSDD=Y
- SET BSDD(1)=Y
- Begin DoDot:1
- +12 NEW BSDWI,BSDPCMM,BSDAMB,BSDPH,BSDCR
- +13 SET BSDWI=1
- SET BSDCR=0
- SET BSDPCMM=1
- SET BSDAMB=1
- SET BSDPH=0
- +14 ;facility restricts seeing who made appt
- IF $$GET1^DIQ(9009020.2,$$DIV^BSDU,.12)="YES"
- IF '$DATA(^XUSEC("SDZSUP",DUZ))
- SET BSDAMB=0
- +15 DO EN^BSDALL
- End DoDot:1
- QUIT
- +16 ;
- +17 ;short appt list
- IF TYPE=2
- DO EN^BSDALS(SC,Y)
- QUIT
