BSDAL1.m

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