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
Q
;
;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
Q
;
GUI(BSDCLN,BSDDT) ;-- future GUI entry point for display
Q
;
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
Q
;
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
Q
;
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"
Q
;
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)=""
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
TOFF ;-- toggle off auto refresh
S BSDRF=0
D RF
Q
;
TON ;-- toggle on auto refresh
S BSDCNT=0
S BSDRF=1
F D RF Q:'$G(BSDRF)
Q
;
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
Q
;
EXIT ; -- exit action for protocol
I $D(VALMBCK),VALMBCK="R" D REFRESH^VALM S VALMBCK=$P(VALMBCK,"R")_$P(VALMBCK,"R",2)
Q
;
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
Q
;
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
