Routine: BSDCHKIN

BSDCHKIN ;cmi/anch/maw - BSD CheckIn Auto Refresh 1/25/2007 1:06:21 PM

 ;;5.3;PIMS;**1007,1009**;FEB 27, 2007

EN ;EP; -- main entry point for BSDAM CHECKIN LIST

 ; variables already set coming into this routine:

 ;   SDCLN = clinic ien in file

 ;   BSDDT = date of clinic appointments to list

 K ^TMP("BSDCHK",$J)

 K ^TMP("SDAM",$J)

 S SDAMTYP="C"

 D CLN

 ;Q:'$D(SDCLN)  cmi/anch/maw 8/15/2007 orig line

 Q:'$D(BSDCLN)  ;cmi/anch/maw 8/15/2007 new line

 D DR

 Q:'$G(BSDDT)

 D EN1

 ;D REFRESH(BSDDT,.VAUTC)

EN1 ;PEP; entry point when clinic or clinic array is known - see technical documentation

 D TERM^VALM0

 NEW VALMCNT D EN^VALM("BSDAM CHECKIN LIST")

 D KILL^AUPNPAT,KVA^VADPT,CLEAR^VALM1

GUI(BSDCLN,BSDDT) ;-- future GUI entry point for display

CLN ;-- lets get the clinic

 K VAUTD

 I $G(BSDDIV) D                         ;division assumed

 . I '$D(DIV) Q                         ;no division variable set

 . I DIV="" S VAUTD=1 Q                 ;already set to all divisions

 . S VAUTD=0,VAUTD(DIV)=$$DIVNM^BSDU(DIV)    ;division already set

 I '$D(VAUTD) D ASK2^SDDIV I Y<0 S BSDQ="" Q

 D GETCLN

GETCLN ;-- get clinics

 S DIC(0)="AEMQZ",DIC="^SC(",DIC("A")="Select Clinic: "

 S DIC("S")="I $P(^(0),U,3)=""C""&'$G(^(""OOS""))&$S(VAUTD:1,$D(VAUTD(+$P(^(0),U,15))):1,'+$P(^(0),U,15)&$D(VAUTD(+$O(^DG(40.8,0)))):1,1:0)"

 S DIC("W")=$$INACTMSG^BSDU  ;IHS/ANMC/LJF 8/17/2000 added this line

 D ^DIC

 I $D(DUOUT) K BSDCLN Q

 Q:Y<0

 ;S SDCLN=+Y  ;cmi/anch/maw 8/15/2007 orig line

 I '$$ACTV^BSDU(+Y,DT) D

 . S X="** Inactivated on "_$$INACTVDT^BSDU(+Y)_" **"

 . D EN^DDIOL(.X)

 S BSDCLN(+Y)=""  ;cmi/anch/maw multiple clinics

 ;D EXPNDPC^BSDU(2,.SDCLN)  ;cmi/anch/maw 8/15/2007 orig line

 D EXPNDPC^BSDU(2,.Y)

 G GETCLN

DR ;-- select date range

 S %DT="AE",%DT("A")="Select Date: ",%DT("B")=$$FMTE^XLFDT(DT)

 D ^%DT

 I Y=-1 K BSDDT Q

 S BSDDT=+Y

 S SDBEG=BSDDT_".0001"

 S SDEND=BSDDT_".9999"

REFRESH(BSDDT,BSDCLNA) ;-- lets build the date/time order array

 N BSDA,BSDB,BSDE

 S BSDB=BSDDT_".0001",BSDE=BSDDT_".9999"

 S BSDA=0 F  S BSDA=$O(BSDCLNA(BSDA)) Q:'BSDA  D

 . N BSDDTA

 . S BSDDTA=BSDB F  S BSDDTA=$O(^SC(BSDA,"S",BSDDTA)) Q:BSDDTA>BSDE!('BSDDTA)  D

 .. N BSDDA

 .. S BSDDA=0 F  S BSDDA=$O(^SC(BSDA,"S",BSDDTA,1,BSDDA)) Q:'BSDDA  D

 ... Q:'$P($G(^SC(BSDA,"S",BSDDTA,1,BSDDA,"C")),U)

 ... N BSDCHK,BSDPAT

 ... S BSDPAT=$P($G(^SC(BSDA,"S",BSDDTA,1,BSDDA,0)),U)

 ... S BSDCHK=$P($G(^SC(BSDA,"S",BSDDTA,1,BSDDA,"C")),U)

 ... S ^TMP("SDAM",$J,BSDA,BSDCHK,BSDPAT)=""

INIT1 ; added line label

 D CLEAR^VALM1  ;IHS/ANMC/LJF 8/18/2000

 S X="CHECKED IN" D LIST

INITQ Q

HDR ; -- screen head

 N X,SDX,SDLNX S SDLNX=2

 S SDLNX=1

 ;I SDAMTYP="C" D HDRC

 S X=$P(SDAMLIST,"^",2)

 S VALMHDR(SDLNX)=X

 ;S X="* - New GAF Required",VALMHDR(SDLNX)=$$SETSTR^VALM1(X,VALMHDR(SDLNX),34,30)              ;IHS/ANMC/LJF 6/1/2000

 S VALMHDR(SDLNX)=$$SETSTR^VALM1($$FDATE^VALM1(SDBEG)_" thru "_$$FDATE^VALM1(SDEND),VALMHDR(SDLNX),59,22)

 S SDLNX=SDLNX+1

 S X=IORVON_"Auto Refresh is: "_IORVOFF_"  "_$S($G(BSDRF):"ON",1:"OFF")

 S VALMHDR(SDLNX)=X

HDRC ;-- clinic header

 ;   input:      SDCLN := ifn of pat

 ;  output:  VALMHDR() := hdr array

 N BSDDA,BSDCLNA

 S BSDCLNA=""

 S BSDDA=0 F  S BSDDA=$O(BSDCLN(BSDDA)) Q:'BSDDA  D

 . N BSDCLNE

 . S BSDCLNE=$E($P(^SC(BSDDA,0),U),1,45)

 . S BSDCLNA=BSDCLNE_"/"_BSDCLNA

 ;S VALMHDR(1)=$E($P("Clinic: "_$G(^SC(SDCLN,0)),"^",1),1,45)  ;for proper display of clinic name for SD*5.3*189

 S VALMHDR(1)="Clinic: "_BSDCLNA  ;for proper display of clinic name for SD*5.3*189

FNL ; -- what to do after action

 K ^TMP("SDAM",$J),^TMP("SDAMIDX",$J),^TMP("VALMIDX",$J),^BSDTMP("BSDCHK",$J)

 K SDAMCNT,SDFLDD,SDACNT,VALMHCNT,SDPRD,SDFN,SDCLN,SDAMLIST,SDT,SDATA,SDBEG,SDEND,DFN,Y,SDAMTYP,SDY,X,SDCL,Y,SDDA,VALMY

 K BSDCLN,BSDCLNA

BLD ; -- entry point to bld list

 ; input:  SDAMLIST := list to build

 D:'$D(SDAMLIST) GROUP("ALL",.SDAMLIST)

 ;I SDAMTYP="C" D BLD1  ;cmi/anch/maw 8/15/2007 orig line

 I SDAMTYP="C" D MCLN(.BSDCLN)

BLDQ Q

LIST ; -- find and build

 ;  input:        X := status group

 ; output: SDAMLIST := array of status'

 I X["CANCELLED",$G(SDAMTYP)="C" S VALMBCK="" W !!,*7,"You must be viewing a patient to list cancelled appointments." D PAUSE^VALM1 G LISTQ

 D GROUP(X,.SDAMLIST),BLD

 S VALMBCK="R"

LISTQ Q

GROUP(GROUP,SDAMLIST) ; -- find list

 S (I,SDAMLIST)="" F  S I=$O(SDAMLIST(I)) Q:I=""  K SDAMLIST(I)

 S GROUP=+$O(^SD(409.62,"B",GROUP,0))

 G GROUPQ:'$D(^SD(409.62,GROUP,0)) S SDAMLIST=^(0)

 S I=$G(^SD(409.62,GROUP,1)) S:I]"" SDAMLIST("SCR")=I

 S I=0 F  S I=$O(^SD(409.63,"C",GROUP,I)) Q:'I  S SDAMLIST(I)=""

GROUPQ Q

FUT ; -- change date range

 S X1=DT,X2=999 D C^%DTC

 S SDEBG=DT,SDEND=X,X="FUTURE" K VALMHDR

 D LIST

FUTQ Q

MCLN(BSDCLNM) ;-- loop through array and call BLD1

 N VA,SDAMDD,SDNAME,SDMAX,SDLARGE,DFN,SDCL,BL,XC,XW,AC,AW,TC,TW,NC,NW,SC,SW,SDT,SDDA ; done for speed see INIT^SDAM10

 D INIT^SDAM10

 S VALMBG=2  ;to reset top of data

 N BSDDA

 S BSDDA=0 F  S BSDDA=$O(BSDCLNM(BSDDA)) Q:'BSDDA  D

 . N BSDCLNE,BSDLN

 . S BSDLN=" "

 . S BSDACNT=SDACNT

 . S SDACNT=0

 . D SET^BSDCHKI1(BSDLN)

 . S SDACNT=BSDACNT

 . S SDCLN=BSDDA

 . S BSDCLNE=$P(^SC(SDCLN,0),U)

 . S BSDLN="Clinic:  "_BSDCLNE

 . S BSDACNT=SDACNT

 . S SDACNT=0

 . D SET^BSDCHKI1(BSDLN)

 . S SDACNT=BSDACNT

 . D BLD1

BLD1 ; -- scan apts

 ;N VA,SDAMDD,SDNAME,SDMAX,SDLARGE,DFN,SDCL,BL,XC,XW,AC,AW,TC,TW,NC,NW,SC,SW,SDT,SDDA ; done for speed see INIT^SDAM10

 ;D INIT^SDAM10  cmi/anch/maw moved to MCLN

 N BSDCHK,BSDDFN

 F SDT=SDBEG:0 S SDT=$O(^SC(SDCLN,"S",SDT)) Q:'SDT!($P(SDT,".",1)>SDEND)  D

 .F SDDA=0:0 S SDDA=$O(^SC(SDCLN,"S",SDT,1,SDDA)) Q:'SDDA  D

 .. Q:'$P($G(^SC(SDCLN,"S",SDT,1,SDDA,"C")),U)

 .. S BSDCHK=$P($G(^SC(SDCLN,"S",SDT,1,SDDA,"C")),U)

 .. S BSDDFN=$P($G(^SC(SDCLN,"S",SDT,1,SDDA,0)),U)

 .. S ^TMP("BSDCHK",$J,SDCLN,BSDCHK,BSDDFN)=SDT_U_SDDA

 N BSDTDA,BSDTIEN

 S BSDTDA="" F  S BSDTDA=$O(^TMP("BSDCHK",$J,SDCLN,BSDTDA),-1) Q:'BSDTDA  D

 . S BSDTIEN=0 F  S BSDTIEN=$O(^TMP("BSDCHK",$J,SDCLN,BSDTDA,BSDTIEN)) Q:'BSDTIEN  D

 .. N BSDTDTA

 .. S BSDTDTA=$G(^TMP("BSDCHK",$J,SDCLN,BSDTDA,BSDTIEN))

 .. S SDDA=$P(BSDTDTA,U,2)

 .. S SDT=$P(BSDTDTA,U)

 .. S DFN=BSDTIEN

 .. S BSDCHKIN=BSDTDA

 .. I $D(^SC(SDCLN,"S",SDT,1,SDDA,0)) S DFN=+^(0) D PID^VADPT I $D(^DPT(DFN,"S",SDT,0)),$$VALID^SDAM2(DFN,SDCLN,SDT,SDDA) S SDATA=^DPT(DFN,"S",SDT,0),SDCL=SDCLN,SDNAME=VA("BID")_" "_$P($G(^DPT(DFN,0)),U) D:SDCLN=+SDATA BLD1^BSDCHKI1

 D NUL^SDAM10,LARGE^SDAM10:$D(SDLARGE)

 S $P(^TMP("SDAM",$J,0),U,4)=VALMCNT

TOFF ;-- toggle off auto refresh

 S BSDRF=0

 D RF

TON ;-- toggle on auto refresh

 S BSDCNT=0

 S BSDRF=1

 F  D RF Q:'$G(BSDRF)

RF ;-- refresh the screen now

 S X="CHECKED IN" D LIST  ;cmi/maw 7/16/2008 to auto refresh clinic checkin list will add to patch 1009

 S VALMBCK="R"

 D EXIT

 Q:'$G(BSDRF)

 S DIR(0)="Y"

 S DIR("A")="Turn Auto Refresh Off "

 S DIR("B")="N"

 S DIR("T")=58

 D ^DIR

 K DIR

 I $G(Y) D TOFF

EXIT ; -- exit action for protocol

 I $D(VALMBCK),VALMBCK="R" D REFRESH^VALM S VALMBCK=$P(VALMBCK,"R")_$P(VALMBCK,"R",2)

HLP ; -- help for list

 I $D(X),X'["??" D HLPS,PAUSE^VALM1 G HLPQ

 D CLEAR^VALM1

 F I=1:1 S SDX=$P($T(HELPTXT+I),";",3,99) Q:SDX="$END"  D PAUSE^VALM1:SDX="$PAUSE" Q:'Y  W !,$S(SDX["$PAUSE":"",1:SDX)

 ;IHS/ANMC/LJF 10/10/2001 modified lines below

 ;W !,"Possible actions are the following:"

 ;D HLPS,PAUSE^VALM1 S VALMBCK="R"

 D CLEAR^VALM1           ;new line

 ;IHS/ANMC/LJF 10/10/2001 end of mods

HLPQ K SDX,Y Q

EX ;-- expand the entry

 S VALMBG=3

 D EN^SDAMEP

 S VALMBG=2

HLPS ; -- short help

 S X="?" D DISP^XQORM1 W ! Q

HELPTXT ; -- help text

 ;;Enter action by typing the name(s), or abbreviation(s).

;;

 ;;$END

BSDCHKIN  ;cmi/anch/maw - BSD CheckIn Auto Refresh 1/25/2007 1:06:21 PM

 +1       ;;5.3;PIMS;**1007,1009**;FEB 27, 2007

 +2       ;

EN        ;EP; -- main entry point for BSDAM CHECKIN LIST

 +1       ; variables already set coming into this routine:

 +2       ;   SDCLN = clinic ien in file

 +3       ;   BSDDT = date of clinic appointments to list

 +4       ;

 +5        KILL ^TMP("BSDCHK",$JOB)

 +6        KILL ^TMP("SDAM",$JOB)

 +7        SET SDAMTYP="C"

 +8        DO CLN

 +9       ;Q:'$D(SDCLN)  cmi/anch/maw 8/15/2007 orig line

 +10      ;cmi/anch/maw 8/15/2007 new line

           IF '$DATA(BSDCLN)

               QUIT

 +11       DO DR

 +12       IF '$GET(BSDDT)

               QUIT

 +13       DO EN1

 +14       QUIT

 +15      ;

 +16      ;D REFRESH(BSDDT,.VAUTC)

EN1       ;PEP; entry point when clinic or clinic array is known - see technical documentation

 +1        DO TERM^VALM0

 +2        NEW VALMCNT

           DO EN^VALM("BSDAM CHECKIN LIST")

 +3        DO KILL^AUPNPAT

           DO KVA^VADPT

           DO CLEAR^VALM1

 +4        QUIT

 +5       ;

GUI(BSDCLN,BSDDT) ;-- future GUI entry point for display

 +1        QUIT

 +2       ;

CLN       ;-- lets get the clinic

 +1        KILL VAUTD

 +2       ;division assumed

           IF $GET(BSDDIV)

               Begin DoDot:1

 +3       ;no division variable set

                   IF '$DATA(DIV)

                       QUIT

 +4       ;already set to all divisions

                   IF DIV=""

                       SET VAUTD=1

                       QUIT

 +5       ;division already set

                   SET VAUTD=0

                   SET VAUTD(DIV)=$$DIVNM^BSDU(DIV)

               End DoDot:1

 +6        IF '$DATA(VAUTD)

               DO ASK2^SDDIV

               IF Y<0

                   SET BSDQ=""

                   QUIT

 +7        DO GETCLN

 +8        QUIT

 +9       ;

GETCLN    ;-- get clinics

 +1        SET DIC(0)="AEMQZ"

           SET DIC="^SC("

           SET DIC("A")="Select Clinic: "

 +2        SET DIC("S")="I $P(^(0),U,3)=""C""&'$G(^(""OOS""))&$S(VAUTD:1,$D(VAUTD(+$P(^(0),U,15))):1,'+$P(^(0),U,15)&$D(VAUTD(+$O(^DG(40.8,0)))):1,1:0)"

 +3       ;IHS/ANMC/LJF 8/17/2000 added this line

           SET DIC("W")=$$INACTMSG^BSDU

 +4        DO ^DIC

 +5        IF $DATA(DUOUT)

               KILL BSDCLN

               QUIT

 +6        IF Y<0

               QUIT

 +7       ;S SDCLN=+Y  ;cmi/anch/maw 8/15/2007 orig line

 +8        IF '$$ACTV^BSDU(+Y,DT)

               Begin DoDot:1

 +9                SET X="** Inactivated on "_$$INACTVDT^BSDU(+Y)_" **"

 +10               DO EN^DDIOL(.X)

               End DoDot:1

 +11      ;cmi/anch/maw multiple clinics

           SET BSDCLN(+Y)=""

 +12      ;D EXPNDPC^BSDU(2,.SDCLN)  ;cmi/anch/maw 8/15/2007 orig line

 +13       DO EXPNDPC^BSDU(2,.Y)

 +14       GOTO GETCLN

 +15       QUIT

 +16      ;

DR        ;-- select date range

 +1        SET %DT="AE"

           SET %DT("A")="Select Date: "

           SET %DT("B")=$$FMTE^XLFDT(DT)

 +2        DO ^%DT

 +3        IF Y=-1

               KILL BSDDT

               QUIT

 +4        SET BSDDT=+Y

 +5        SET SDBEG=BSDDT_".0001"

 +6        SET SDEND=BSDDT_".9999"

 +7        QUIT

 +8       ;

REFRESH(BSDDT,BSDCLNA) ;-- lets build the date/time order array

 +1        NEW BSDA,BSDB,BSDE

 +2        SET BSDB=BSDDT_".0001"

           SET BSDE=BSDDT_".9999"

 +3        SET BSDA=0

FOR

               SET BSDA=$ORDER(BSDCLNA(BSDA))

               IF 'BSDA

                   QUIT

               Begin DoDot:1

 +4                NEW BSDDTA

 +5                SET BSDDTA=BSDB

FOR

                       SET BSDDTA=$ORDER(^SC(BSDA,"S",BSDDTA))

                       IF BSDDTA>BSDE!('BSDDTA)

                           QUIT

                       Begin DoDot:2

 +6                        NEW BSDDA

 +7                        SET BSDDA=0

FOR

                               SET BSDDA=$ORDER(^SC(BSDA,"S",BSDDTA,1,BSDDA))

                               IF 'BSDDA

                                   QUIT

                               Begin DoDot:3

 +8                                IF '$PIECE($GET(^SC(BSDA,"S",BSDDTA,1,BSDDA,"C")),U)

                                       QUIT

 +9                                NEW BSDCHK,BSDPAT

 +10                               SET BSDPAT=$PIECE($GET(^SC(BSDA,"S",BSDDTA,1,BSDDA,0)),U)

 +11                               SET BSDCHK=$PIECE($GET(^SC(BSDA,"S",BSDDTA,1,BSDDA,"C")),U)

 +12                               SET ^TMP("SDAM",$JOB,BSDA,BSDCHK,BSDPAT)=""

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +13       QUIT

 +14      ;

INIT1     ; added line label

 +1       ;IHS/ANMC/LJF 8/18/2000

           DO CLEAR^VALM1

 +2        SET X="CHECKED IN"

           DO LIST

INITQ      QUIT

 +1       ;

HDR       ; -- screen head

 +1        NEW X,SDX,SDLNX

           SET SDLNX=2

 +2        SET SDLNX=1

 +3       ;I SDAMTYP="C" D HDRC

 +4        SET X=$PIECE(SDAMLIST,"^",2)

 +5        SET VALMHDR(SDLNX)=X

 +6       ;S X="* - New GAF Required",VALMHDR(SDLNX)=$$SETSTR^VALM1(X,VALMHDR(SDLNX),34,30)              ;IHS/ANMC/LJF 6/1/2000

 +7        SET VALMHDR(SDLNX)=$$SETSTR^VALM1($$FDATE^VALM1(SDBEG)_" thru "_$$FDATE^VALM1(SDEND),VALMHDR(SDLNX),59,22)

 +8        SET SDLNX=SDLNX+1

 +9        SET X=IORVON_"Auto Refresh is: "_IORVOFF_"  "_$SELECT($GET(BSDRF):"ON",1:"OFF")

 +10       SET VALMHDR(SDLNX)=X

 +11       QUIT

 +12      ;

HDRC      ;-- clinic header

 +1       ;   input:      SDCLN := ifn of pat

 +2       ;  output:  VALMHDR() := hdr array

 +3       ;

 +4        NEW BSDDA,BSDCLNA

 +5        SET BSDCLNA=""

 +6        SET BSDDA=0

FOR

               SET BSDDA=$ORDER(BSDCLN(BSDDA))

               IF 'BSDDA

                   QUIT

               Begin DoDot:1

 +7                NEW BSDCLNE

 +8                SET BSDCLNE=$EXTRACT($PIECE(^SC(BSDDA,0),U),1,45)

 +9                SET BSDCLNA=BSDCLNE_"/"_BSDCLNA

               End DoDot:1

 +10      ;S VALMHDR(1)=$E($P("Clinic: "_$G(^SC(SDCLN,0)),"^",1),1,45)  ;for proper display of clinic name for SD*5.3*189

 +11      ;for proper display of clinic name for SD*5.3*189

           SET VALMHDR(1)="Clinic: "_BSDCLNA

 +12       QUIT

 +13      ;

FNL       ; -- what to do after action

 +1        KILL ^TMP("SDAM",$JOB),^TMP("SDAMIDX",$JOB),^TMP("VALMIDX",$JOB),^BSDTMP("BSDCHK",$JOB)

 +2        KILL SDAMCNT,SDFLDD,SDACNT,VALMHCNT,SDPRD,SDFN,SDCLN,SDAMLIST,SDT,SDATA,SDBEG,SDEND,DFN,Y,SDAMTYP,SDY,X,SDCL,Y,SDDA,VALMY

 +3        KILL BSDCLN,BSDCLNA

 +4        QUIT

 +5       ;

BLD       ; -- entry point to bld list

 +1       ; input:  SDAMLIST := list to build

 +2        IF '$DATA(SDAMLIST)

               DO GROUP("ALL",.SDAMLIST)

 +3       ;I SDAMTYP="C" D BLD1  ;cmi/anch/maw 8/15/2007 orig line

 +4        IF SDAMTYP="C"

               DO MCLN(.BSDCLN)

BLDQ       QUIT

 +1       ;

LIST      ; -- find and build

 +1       ;  input:        X := status group

 +2       ; output: SDAMLIST := array of status'

 +3       ;

 +4        IF X["CANCELLED"

               IF $GET(SDAMTYP)="C"

                   SET VALMBCK=""

                   WRITE !!,*7,"You must be viewing a patient to list cancelled appointments."

                   DO PAUSE^VALM1

                   GOTO LISTQ

 +5        DO GROUP(X,.SDAMLIST)

           DO BLD

 +6        SET VALMBCK="R"

LISTQ      QUIT

 +1       ;

GROUP(GROUP,SDAMLIST) ; -- find list

 +1        SET (I,SDAMLIST)=""

FOR

               SET I=$ORDER(SDAMLIST(I))

               IF I=""

                   QUIT

               KILL SDAMLIST(I)

 +2        SET GROUP=+$ORDER(^SD(409.62,"B",GROUP,0))

 +3        IF '$DATA(^SD(409.62,GROUP,0))

               GOTO GROUPQ

           SET SDAMLIST=^(0)

 +4        SET I=$GET(^SD(409.62,GROUP,1))

           IF I]""

               SET SDAMLIST("SCR")=I

 +5        SET I=0

FOR

               SET I=$ORDER(^SD(409.63,"C",GROUP,I))

               IF 'I

                   QUIT

               SET SDAMLIST(I)=""

GROUPQ     QUIT

 +1       ;

FUT       ; -- change date range

 +1        SET X1=DT

           SET X2=999

           DO C^%DTC

 +2        SET SDEBG=DT

           SET SDEND=X

           SET X="FUTURE"

           KILL VALMHDR

 +3        DO LIST

FUTQ       QUIT

 +1       ;

MCLN(BSDCLNM) ;-- loop through array and call BLD1

 +1       ; done for speed see INIT^SDAM10

           NEW VA,SDAMDD,SDNAME,SDMAX,SDLARGE,DFN,SDCL,BL,XC,XW,AC,AW,TC,TW,NC,NW,SC,SW,SDT,SDDA

 +2        DO INIT^SDAM10

 +3       ;to reset top of data

           SET VALMBG=2

 +4        NEW BSDDA

 +5        SET BSDDA=0

FOR

               SET BSDDA=$ORDER(BSDCLNM(BSDDA))

               IF 'BSDDA

                   QUIT

               Begin DoDot:1

 +6                NEW BSDCLNE,BSDLN

 +7                SET BSDLN=" "

 +8                SET BSDACNT=SDACNT

 +9                SET SDACNT=0

 +10               DO SET^BSDCHKI1(BSDLN)

 +11               SET SDACNT=BSDACNT

 +12               SET SDCLN=BSDDA

 +13               SET BSDCLNE=$PIECE(^SC(SDCLN,0),U)

 +14               SET BSDLN="Clinic:  "_BSDCLNE

 +15               SET BSDACNT=SDACNT

 +16               SET SDACNT=0

 +17               DO SET^BSDCHKI1(BSDLN)

 +18               SET SDACNT=BSDACNT

 +19               DO BLD1

               End DoDot:1

 +20       QUIT

 +21      ;

BLD1      ; -- scan apts

 +1       ;N VA,SDAMDD,SDNAME,SDMAX,SDLARGE,DFN,SDCL,BL,XC,XW,AC,AW,TC,TW,NC,NW,SC,SW,SDT,SDDA ; done for speed see INIT^SDAM10

 +2       ;D INIT^SDAM10  cmi/anch/maw moved to MCLN

 +3        NEW BSDCHK,BSDDFN

 +4        FOR SDT=SDBEG:0

               SET SDT=$ORDER(^SC(SDCLN,"S",SDT))

               IF 'SDT!($PIECE(SDT,".",1)>SDEND)

                   QUIT

               Begin DoDot:1

 +5                FOR SDDA=0:0

                       SET SDDA=$ORDER(^SC(SDCLN,"S",SDT,1,SDDA))

                       IF 'SDDA

                           QUIT

                       Begin DoDot:2

 +6                        IF '$PIECE($GET(^SC(SDCLN,"S",SDT,1,SDDA,"C")),U)

                               QUIT

 +7                        SET BSDCHK=$PIECE($GET(^SC(SDCLN,"S",SDT,1,SDDA,"C")),U)

 +8                        SET BSDDFN=$PIECE($GET(^SC(SDCLN,"S",SDT,1,SDDA,0)),U)

 +9                        SET ^TMP("BSDCHK",$JOB,SDCLN,BSDCHK,BSDDFN)=SDT_U_SDDA

                       End DoDot:2

               End DoDot:1

 +10       NEW BSDTDA,BSDTIEN

 +11       SET BSDTDA=""

FOR

               SET BSDTDA=$ORDER(^TMP("BSDCHK",$JOB,SDCLN,BSDTDA),-1)

               IF 'BSDTDA

                   QUIT

               Begin DoDot:1

 +12               SET BSDTIEN=0

FOR

                       SET BSDTIEN=$ORDER(^TMP("BSDCHK",$JOB,SDCLN,BSDTDA,BSDTIEN))

                       IF 'BSDTIEN

                           QUIT

                       Begin DoDot:2

 +13                       NEW BSDTDTA

 +14                       SET BSDTDTA=$GET(^TMP("BSDCHK",$JOB,SDCLN,BSDTDA,BSDTIEN))

 +15                       SET SDDA=$PIECE(BSDTDTA,U,2)

 +16                       SET SDT=$PIECE(BSDTDTA,U)

 +17                       SET DFN=BSDTIEN

 +18                       SET BSDCHKIN=BSDTDA

 +19                       IF $DATA(^SC(SDCLN,"S",SDT,1,SDDA,0))

                               SET DFN=+^(0)

                               DO PID^VADPT

                               IF $DATA(^DPT(DFN,"S",SDT,0))

                                   IF $$VALID^SDAM2(DFN,SDCLN,SDT,SDDA)

                                       SET SDATA=^DPT(DFN,"S",SDT,0)

                                       SET SDCL=SDCLN

                                       SET SDNAME=VA("BID")_" "_$PIECE($GET(^DPT(DFN,0)),U)

                                       IF SDCLN=+SDATA

                                           DO BLD1^BSDCHKI1

                       End DoDot:2

               End DoDot:1

 +20       DO NUL^SDAM10

           IF $DATA(SDLARGE)

               DO LARGE^SDAM10

 +21       SET $PIECE(^TMP("SDAM",$JOB,0),U,4)=VALMCNT

 +22       QUIT

 +23      ;

TOFF      ;-- toggle off auto refresh

 +1        SET BSDRF=0

 +2        DO RF

 +3        QUIT

 +4       ;

TON       ;-- toggle on auto refresh

 +1        SET BSDCNT=0

 +2        SET BSDRF=1

 +3        FOR

               DO RF

               IF '$GET(BSDRF)

                   QUIT

 +4        QUIT

 +5       ;

RF        ;-- refresh the screen now

 +1       ;cmi/maw 7/16/2008 to auto refresh clinic checkin list will add to patch 1009

           SET X="CHECKED IN"

           DO LIST

 +2        SET VALMBCK="R"

 +3        DO EXIT

 +4        IF '$GET(BSDRF)

               QUIT

 +5        SET DIR(0)="Y"

 +6        SET DIR("A")="Turn Auto Refresh Off "

 +7        SET DIR("B")="N"

 +8        SET DIR("T")=58

 +9        DO ^DIR

 +10       KILL DIR

 +11       IF $GET(Y)

               DO TOFF

 +12       QUIT

 +13      ;

EXIT      ; -- exit action for protocol

 +1        IF $DATA(VALMBCK)

               IF VALMBCK="R"

                   DO REFRESH^VALM

                   SET VALMBCK=$PIECE(VALMBCK,"R")_$PIECE(VALMBCK,"R",2)

 +2        QUIT

 +3       ;

HLP       ; -- help for list

 +1        IF $DATA(X)

               IF X'["??"

                   DO HLPS

                   DO PAUSE^VALM1

                   GOTO HLPQ

 +2        DO CLEAR^VALM1

 +3        FOR I=1:1

               SET SDX=$PIECE($TEXT(HELPTXT+I),";",3,99)

               IF SDX="$END"

                   QUIT

               IF SDX="$PAUSE"

                   DO PAUSE^VALM1

               IF 'Y

                   QUIT

               WRITE !,$SELECT(SDX["$PAUSE":"",1:SDX)

 +4       ;

 +5       ;IHS/ANMC/LJF 10/10/2001 modified lines below

 +6       ;W !,"Possible actions are the following:"

 +7       ;D HLPS,PAUSE^VALM1 S VALMBCK="R"

 +8       ;new line

           DO CLEAR^VALM1

 +9       ;IHS/ANMC/LJF 10/10/2001 end of mods

 +10      ;

HLPQ       KILL SDX,Y

           QUIT

 +1       ;

EX        ;-- expand the entry

 +1        SET VALMBG=3

 +2        DO EN^SDAMEP

 +3        SET VALMBG=2

 +4        QUIT

 +5       ;

HLPS      ; -- short help

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !

           QUIT

 +2       ;

HELPTXT   ; -- help text

 +1       ;;Enter action by typing the name(s), or abbreviation(s).

 +2       ;;

 +3       ;;$END

BSDCHKIN.m