SDAM2 ;ALB/MJK - Appt Mgt (cont); 8/18/05 12:10pm ; Compiled April 16, 2007 09:43:32
;;5.3;Scheduling;**250,296,327,478,446,1005,1012,1015**;Aug 13, 1993;Build 21
;IHS/ANMC/LJF 6/29/2000 added display of PCP as reminder
; 7/05/2000 added display of CMS register memberships
; added pending appt display before clinic quest
; 7/06/2000 added code to clear screen after make appt
; 12/07/2000 added last registration update to display
; prevent checking in patients with temp #s
; 9/25/2003 update status (to blink or not to blink)
;IHS/OIT/LJF 12/29/2005 PATCH 1005 - removed 9/25/2003 code to update status
; 12/30/2005 PATCH 1005 - moved pend appt display code to BSDAM
;
;cmi/flag/maw 06/02/2010 PATCH 1012 RQMT 149 add check of valid appointment
;
CI ; -- protocol SDAM APPT CHECK IN entry pt
; input: VALMY := array entries
;
N %,SDI,SDAT,VALMY,SDAMCIDT,SDCIACT
D SEL^VALM2 S SDI=0,SDCIACT=""
D NOW^%DTC S SDAMCIDT=$P(%,".")_"."_$E($P(%,".",2)_"0000",1,4)
F S SDI=$O(VALMY(SDI)) Q:'SDI I $D(^TMP("SDAMIDX",$J,SDI)) K SDAT D
.S SDAT=^TMP("SDAMIDX",$J,SDI)
.W !,^TMP("SDAM",$J,+SDAT,0)
.;
.;IHS/ANMC/LJF 12/07/2000 no temp #, show last reg update
.I $$HRCN^BDGF2(+$P(SDAT,U,2),DUZ(2))["T" D Q
.. W !?5,"**** CANNOT check in patient with temporary chart #. ****"
.. D PAUSE^BDGF
.W !?5,"Last Registration Update: ",$$LASTREG^BDGF2($P(SDAT,U,2))
.;IHS/ANMC/LJF 12/07/2000 end of additions
.;
.D:VALMCC SELECT^VALM10(+SDAT,1)
.D ONE($P(SDAT,U,2),$P(SDAT,U,4),$P(SDAT,U,3),$P(SDAT,U,5),0,SDAMCIDT)
.D:VALMCC SELECT^VALM10(+SDAT,0)
S VALMBCK=$S(VALMCC:"",1:"R")
Q
;
ONE(DFN,SDCL,SDT,SDDA,SDASK,SDAMCIDT) ; -- check in one appt
; input: DFN := ifn of patient
; SDCL := clinic#
; SDT := appt d/t
; SDDA := ifn in ^SC multiple or null
; SDASK := ask d/t of ci always [1|yes or 0|no]
; SDAMCIDT := ci date/time [optional]
;
I $D(XRTL) D T0^%ZOSV
S:'SDDA SDDA=$$FIND(DFN,SDT,SDCL)
I 'SDDA W !!,*7,"You cannot check in this appointment." D PAUSE^VALM1 G ONEQ
N SDATA,SDCIHDL,X S SDATA=SDDA_U_DFN_U_SDT_U_SDCL,SDCIHDL=$$HANDLE^SDAMEVT(1)
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
I '$D(^SD(409.63,"ACI",1,+SDATA("BEFORE","STATUS"))) W !!,*7,"You cannot check in this appointment." D PAUSE^VALM1 G ONEQ
; *** mt blocking removed
;S X="EASMTCHK" X ^%ZOSF("TEST") I $T,$G(EASACT)'="W",$$MT^EASMTCHK(DFN,"","C",SDT) D PAUSE^VALM1 G ONEQ
I $P(SDT,".")>DT W !!,*7,"It is too soon to check in this appointment." D PAUSE^VALM1 G ONEQ
S:'$D(^SC(SDCL,"S",0)) ^(0)="^44.001DA^^"
S DR="",X=$G(^SC(SDCL,"S",SDT,1,SDDA,"C"))
I +X S DR=309
; -- already co'ed
I DR="",$P(X,U,3) D
.S DR="309//"
.I $P(^SC(SDCL,0),U,24)!(SDASK) S DR=DR_$$FTIME^VALM1($P(X,U,3)) Q
.S DR=DR_"//^S X="_$P(X,U,3)
;
I DR="",$P(^SC(SDCL,0),U,24)!(SDASK) S DR="309//"_$S(SDAMCIDT:$$FTIME^VALM1(SDAMCIDT),1:"NOW")
I DR="" S DR="309///"_$S(SDAMCIDT:"/"_SDAMCIDT,1:"NOW")
S DA(2)=SDCL,DA(1)=SDT,DA=SDDA,DIE="^SC("_DA(2)_",""S"","_DA(1)_",1," D ^DIE
D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
I '$P(SDATA("AFTER","STATUS"),U,4),'$P(SDATA("BEFORE","STATUS"),U,4) W !?8,*7,"...appointment has not been checked in" D PAUSE^VALM1
I SDATA("BEFORE","STATUS")'=SDATA("AFTER","STATUS") D
.I $P(SDATA("AFTER","STATUS"),U,4),'$P(SDATA("BEFORE","STATUS"),U,4) W !?8,"...checked in ",$$FTIME^VALM1($P(SDATA("AFTER","STATUS"),U,4))
.I $D(SDCIACT) D
..S Y=SDATA("AFTER","STATUS"),Y1=$P(Y,U,4),Y=$P(Y,U,3)
..I $P(SDATA("BEFORE","STATUS"),U,3)'=Y D UPD($$LOWER^VALM1(Y),"STAT",+SDAT,1),UPD("","TIME",+SDAT,1)
..I $P(SDATA("AFTER","STATUS"),U,3)["CHECKED IN" D UPD($S($P(Y1,".")=DT:$$TIME^SDAM1($P(Y1,".",2)),1:" "),"TIME",+SDAT,1)
.D EVT^SDAMEVT(.SDATA,4,0,SDCIHDL) ; 4 := ci evt , 0 := interactive mode
I $D(XRT0) S XRTN="SDAM2" D T1^%ZOSV
ONEQ K DA,DIE,DR,DQ,DE,Y,Y1 Q
;
;
FIND(DFN,SDT,SDCL) ; -- return appt ifn for pat
; input: DFN := ifn of pat.
; SDT := appt d/t
; SDCL := ifn of clinic
; output: [returned] := ifn if pat has appt on date/time
;
N Y
S Y=0 F S Y=$O(^SC(SDCL,"S",SDT,1,Y)) Q:'Y I $D(^(Y,0)),DFN=+^(0),$D(^DPT(+DFN,"S",SDT,0)),$$VALID(DFN,SDCL,SDT,Y) S CNSTLNK=$P($G(^SC(SDCL,"S",SDT,1,Y,"CONS")),U) K:CNSTLNK="" CNSTLNK Q ;SD/478
Q Y
;
UPD(TEXT,FLD,LINE,SAVE) ; -- update data for screen
D FLDTEXT^VALM10(LINE,FLD,TEXT)
D:VALMCC CNTRL^VALM10(LINE,$P(VALMDDF(FLD),U,2),$P(VALMDDF(FLD),U,3),IOINHI,IOINORM,+$G(SAVE))
Q
;
MAKE ; -- make appt action
N ORACTION,ORVP,XQORQUIT,SDAMERR
D FULL^VALM1
W !!,VALMHDR(1)
;
;IHS/OIT/LJF 12/30/2005 PATCH 1005 moved display code to BSDAM
;IHS/ANMC/LJF IHS updates to display (6/29/2000 7/5/2000 12/7/2000)
I SDAMTYP="P" D PTAPPT^BSDAM(DFN)
;
D ^SDM
I '$D(SDAMERR) D BLD^SDAM
I $D(SDAMERR) D PAUSE^VALM1
D SDM^SDKILL S VALMBCK="R"
D CLEAR^VALM1 ;IHS/ANMC/LJF 7/06/2000
Q
;
WI ; -- walk-in visit action
S VALMBCK="R"
D FULL^VALM1
I SDAMTYP="P" I $$CL^SDAMWI(SDFN) D BLD^SDAM1
I SDAMTYP="C" I $$PT^SDAMWI(SDCLN) D BLD^SDAM3
;evaluate wait list ;SD/327
EWLCHK ;check if patient has any open EWL entries (SD/372)
;CLN expected as clinic IEN
I '$D(DFN) Q
Q:'$D(SDT)
K ^TMP($J,"SDAMA301"),^TMP($J,"APPT")
N SD S SD=SDT
I '$D(SC) S SC=+$G(CLN)
;
K ^TMP($J,"SDAMA301"),^TMP($J,"APPT")
W:$D(IOF) @IOF D APPT^SDWLEVAL(DFN,SD,SC)
Q:'$D(^TMP($J,"APPT"))
N SDEV D EN^SDWLEVAL(DFN,.SDEV) I SDEV,$L(SDEV(1))>0 D
.K ^TMP("SDWLPL",$J),^TMP($J,"SDWLPL")
.D INIT^SDWLPL(DFN,"M")
.Q:'$D(^TMP($J,"SDWLPL"))
.D LIST^SDWLPL("M",DFN)
.F Q:'$D(^TMP($J,"SDWLPL")) N SDR D ANSW^SDWLEVAL(1,.SDR) I 'SDR D LIST^SDWLPL("M",DFN) D
..F N SDR D ANSW^SDWLEVAL(0,.SDR) Q:'$D(^TMP($J,"SDWLPL")) I 'SDR W !,"MUST ENTER A REASON NOT TO DISPOSITION MATCHED EWL ENTRY",!
I $D(^TMP($J,"APPT")) N SDEV D EN^SDWLEVAL(DFN,.SDEV) I SDEV,$L(SDEV(1))>0 D
.Q:'$D(^TMP($J,"SDWLPL")) D ASKREM^SDWLEVAL S SDCTN=1 ;display and process selected open EWL entries
.Q
Q
;
DATE ; -- change date range
S VALMB=SDBEG D RANGE^VALM11
I $S('VALMBEG:1,SDBEG'=VALMBEG:0,1:SDEND=VALMEND) W !!,"Date range was not changed." D PAUSE^VALM1 S VALMBCK="" G DATEQ
S SDBEG=VALMBEG,SDEND=VALMEND
I SDAMTYP="P" D BLD^SDAM1
I SDAMTYP="C" D BLD^SDAM3
S VALMBCK="R"
DATEQ K VALMB,VALMBEG,VALMEND Q
;
INP(DFN,VDATE) ; -- determine inpat status ; dom is not an inpat appt
N SDINP,VAINDT,VADMVT
S SDINP="",VAINDT=VDATE D ADM^VADPT2 G INPQ:'VADMVT
I $P(^DG(43,1,0),U,21),$P($G(^DIC(42,+$P($G(^DGPM(VADMVT,0)),U,6),0)),U,3)="D" G INPQ
S SDINP="I"
INPQ Q SDINP
;
VALID(DFN,SDCL,SDT,SDDA) ; -- return valid appt.
; **NOTE: For speed consideration the ^SC and ^DPT nodes must be
; check to see they exist prior to calling this entry point.
; input: DFN := ifn of pat.
; SDT := appt d/t
; SDCL := ifn of clinic
; SDDA := ifn of appt
; output: [returned] := 1 for valid appt., 0 for not valid
Q $S($P(^SC(SDCL,"S",SDT,1,SDDA,0),U,9)'="C":1,$P(^DPT(DFN,"S",SDT,0),U,2)["C":1,1:0)
SDAM2 ;ALB/MJK - Appt Mgt (cont); 8/18/05 12:10pm ; Compiled April 16, 2007 09:43:32
+1 ;;5.3;Scheduling;**250,296,327,478,446,1005,1012,1015**;Aug 13, 1993;Build 21
+2 ;IHS/ANMC/LJF 6/29/2000 added display of PCP as reminder
+3 ; 7/05/2000 added display of CMS register memberships
+4 ; added pending appt display before clinic quest
+5 ; 7/06/2000 added code to clear screen after make appt
+6 ; 12/07/2000 added last registration update to display
+7 ; prevent checking in patients with temp #s
+8 ; 9/25/2003 update status (to blink or not to blink)
+9 ;IHS/OIT/LJF 12/29/2005 PATCH 1005 - removed 9/25/2003 code to update status
+10 ; 12/30/2005 PATCH 1005 - moved pend appt display code to BSDAM
+11 ;
+12 ;cmi/flag/maw 06/02/2010 PATCH 1012 RQMT 149 add check of valid appointment
+13 ;
CI ; -- protocol SDAM APPT CHECK IN entry pt
+1 ; input: VALMY := array entries
+2 ;
+3 NEW %,SDI,SDAT,VALMY,SDAMCIDT,SDCIACT
+4 DO SEL^VALM2
SET SDI=0
SET SDCIACT=""
+5 DO NOW^%DTC
SET SDAMCIDT=$PIECE(%,".")_"."_$EXTRACT($PIECE(%,".",2)_"0000",1,4)
+6 FOR
SET SDI=$ORDER(VALMY(SDI))
IF 'SDI
QUIT
IF $DATA(^TMP("SDAMIDX",$JOB,SDI))
KILL SDAT
Begin DoDot:1
+7 SET SDAT=^TMP("SDAMIDX",$JOB,SDI)
+8 WRITE !,^TMP("SDAM",$JOB,+SDAT,0)
+9 ;
+10 ;IHS/ANMC/LJF 12/07/2000 no temp #, show last reg update
+11 IF $$HRCN^BDGF2(+$PIECE(SDAT,U,2),DUZ(2))["T"
Begin DoDot:2
+12 WRITE !?5,"**** CANNOT check in patient with temporary chart #. ****"
+13 DO PAUSE^BDGF
End DoDot:2
QUIT
+14 WRITE !?5,"Last Registration Update: ",$$LASTREG^BDGF2($PIECE(SDAT,U,2))
+15 ;IHS/ANMC/LJF 12/07/2000 end of additions
+16 ;
+17 IF VALMCC
DO SELECT^VALM10(+SDAT,1)
+18 DO ONE($PIECE(SDAT,U,2),$PIECE(SDAT,U,4),$PIECE(SDAT,U,3),$PIECE(SDAT,U,5),0,SDAMCIDT)
+19 IF VALMCC
DO SELECT^VALM10(+SDAT,0)
End DoDot:1
+20 SET VALMBCK=$SELECT(VALMCC:"",1:"R")
+21 QUIT
+22 ;
ONE(DFN,SDCL,SDT,SDDA,SDASK,SDAMCIDT) ; -- check in one appt
+1 ; input: DFN := ifn of patient
+2 ; SDCL := clinic#
+3 ; SDT := appt d/t
+4 ; SDDA := ifn in ^SC multiple or null
+5 ; SDASK := ask d/t of ci always [1|yes or 0|no]
+6 ; SDAMCIDT := ci date/time [optional]
+7 ;
+8 IF $DATA(XRTL)
DO T0^%ZOSV
+9 IF 'SDDA
SET SDDA=$$FIND(DFN,SDT,SDCL)
+10 IF 'SDDA
WRITE !!,*7,"You cannot check in this appointment."
DO PAUSE^VALM1
GOTO ONEQ
+11 NEW SDATA,SDCIHDL,X
SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
SET SDCIHDL=$$HANDLE^SDAMEVT(1)
+12 DO BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+13 IF '$DATA(^SD(409.63,"ACI",1,+SDATA("BEFORE","STATUS")))
WRITE !!,*7,"You cannot check in this appointment."
DO PAUSE^VALM1
GOTO ONEQ
+14 ; *** mt blocking removed
+15 ;S X="EASMTCHK" X ^%ZOSF("TEST") I $T,$G(EASACT)'="W",$$MT^EASMTCHK(DFN,"","C",SDT) D PAUSE^VALM1 G ONEQ
+16 IF $PIECE(SDT,".")>DT
WRITE !!,*7,"It is too soon to check in this appointment."
DO PAUSE^VALM1
GOTO ONEQ
+17 IF '$DATA(^SC(SDCL,"S",0))
SET ^(0)="^44.001DA^^"
+18 SET DR=""
SET X=$GET(^SC(SDCL,"S",SDT,1,SDDA,"C"))
+19 IF +X
SET DR=309
+20 ; -- already co'ed
+21 IF DR=""
IF $PIECE(X,U,3)
Begin DoDot:1
+22 SET DR="309//"
+23 IF $PIECE(^SC(SDCL,0),U,24)!(SDASK)
SET DR=DR_$$FTIME^VALM1($PIECE(X,U,3))
QUIT
+24 SET DR=DR_"//^S X="_$PIECE(X,U,3)
End DoDot:1
+25 ;
+26 IF DR=""
IF $PIECE(^SC(SDCL,0),U,24)!(SDASK)
SET DR="309//"_$SELECT(SDAMCIDT:$$FTIME^VALM1(SDAMCIDT),1:"NOW")
+27 IF DR=""
SET DR="309///"_$SELECT(SDAMCIDT:"/"_SDAMCIDT,1:"NOW")
+28 SET DA(2)=SDCL
SET DA(1)=SDT
SET DA=SDDA
SET DIE="^SC("_DA(2)_",""S"","_DA(1)_",1,"
DO ^DIE
+29 DO AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+30 IF '$PIECE(SDATA("AFTER","STATUS"),U,4)
IF '$PIECE(SDATA("BEFORE","STATUS"),U,4)
WRITE !?8,*7,"...appointment has not been checked in"
DO PAUSE^VALM1
+31 IF SDATA("BEFORE","STATUS")'=SDATA("AFTER","STATUS")
Begin DoDot:1
+32 IF $PIECE(SDATA("AFTER","STATUS"),U,4)
IF '$PIECE(SDATA("BEFORE","STATUS"),U,4)
WRITE !?8,"...checked in ",$$FTIME^VALM1($PIECE(SDATA("AFTER","STATUS"),U,4))
+33 IF $DATA(SDCIACT)
Begin DoDot:2
+34 SET Y=SDATA("AFTER","STATUS")
SET Y1=$PIECE(Y,U,4)
SET Y=$PIECE(Y,U,3)
+35 IF $PIECE(SDATA("BEFORE","STATUS"),U,3)'=Y
DO UPD($$LOWER^VALM1(Y),"STAT",+SDAT,1)
DO UPD("","TIME",+SDAT,1)
+36 IF $PIECE(SDATA("AFTER","STATUS"),U,3)["CHECKED IN"
DO UPD($SELECT($PIECE(Y1,".")=DT:$$TIME^SDAM1($PIECE(Y1,".",2)),1:" "),"TIME",+SDAT,1)
End DoDot:2
+37 ; 4 := ci evt , 0 := interactive mode
DO EVT^SDAMEVT(.SDATA,4,0,SDCIHDL)
End DoDot:1
+38 IF $DATA(XRT0)
SET XRTN="SDAM2"
DO T1^%ZOSV
ONEQ KILL DA,DIE,DR,DQ,DE,Y,Y1
QUIT
+1 ;
+2 ;
FIND(DFN,SDT,SDCL) ; -- return appt ifn for pat
+1 ; input: DFN := ifn of pat.
+2 ; SDT := appt d/t
+3 ; SDCL := ifn of clinic
+4 ; output: [returned] := ifn if pat has appt on date/time
+5 ;
+6 NEW Y
+7 ;SD/478
SET Y=0
FOR
SET Y=$ORDER(^SC(SDCL,"S",SDT,1,Y))
IF 'Y
QUIT
IF $DATA(^(Y,0))
IF DFN=+^(0)
IF $DATA(^DPT(+DFN,"S",SDT,0))
IF $$VALID(DFN,SDCL,SDT,Y)
SET CNSTLNK=$PIECE($GET(^SC(SDCL,"S",SDT,1,Y,"CONS")),U)
IF CNSTLNK=""
KILL CNSTLNK
QUIT
+8 QUIT Y
+9 ;
UPD(TEXT,FLD,LINE,SAVE) ; -- update data for screen
+1 DO FLDTEXT^VALM10(LINE,FLD,TEXT)
+2 IF VALMCC
DO CNTRL^VALM10(LINE,$PIECE(VALMDDF(FLD),U,2),$PIECE(VALMDDF(FLD),U,3),IOINHI,IOINORM,+$GET(SAVE))
+3 QUIT
+4 ;
MAKE ; -- make appt action
+1 NEW ORACTION,ORVP,XQORQUIT,SDAMERR
+2 DO FULL^VALM1
+3 WRITE !!,VALMHDR(1)
+4 ;
+5 ;IHS/OIT/LJF 12/30/2005 PATCH 1005 moved display code to BSDAM
+6 ;IHS/ANMC/LJF IHS updates to display (6/29/2000 7/5/2000 12/7/2000)
+7 IF SDAMTYP="P"
DO PTAPPT^BSDAM(DFN)
+8 ;
+9 DO ^SDM
+10 IF '$DATA(SDAMERR)
DO BLD^SDAM
+11 IF $DATA(SDAMERR)
DO PAUSE^VALM1
+12 DO SDM^SDKILL
SET VALMBCK="R"
+13 ;IHS/ANMC/LJF 7/06/2000
DO CLEAR^VALM1
+14 QUIT
+15 ;
WI ; -- walk-in visit action
+1 SET VALMBCK="R"
+2 DO FULL^VALM1
+3 IF SDAMTYP="P"
IF $$CL^SDAMWI(SDFN)
DO BLD^SDAM1
+4 IF SDAMTYP="C"
IF $$PT^SDAMWI(SDCLN)
DO BLD^SDAM3
+5 ;evaluate wait list ;SD/327
EWLCHK ;check if patient has any open EWL entries (SD/372)
+1 ;CLN expected as clinic IEN
+2 IF '$DATA(DFN)
QUIT
+3 IF '$DATA(SDT)
QUIT
+4 KILL ^TMP($JOB,"SDAMA301"),^TMP($JOB,"APPT")
+5 NEW SD
SET SD=SDT
+6 IF '$DATA(SC)
SET SC=+$GET(CLN)
+7 ;
+8 KILL ^TMP($JOB,"SDAMA301"),^TMP($JOB,"APPT")
+9 IF $DATA(IOF)
WRITE @IOF
DO APPT^SDWLEVAL(DFN,SD,SC)
+10 IF '$DATA(^TMP($JOB,"APPT"))
QUIT
+11 NEW SDEV
DO EN^SDWLEVAL(DFN,.SDEV)
IF SDEV
IF $LENGTH(SDEV(1))>0
Begin DoDot:1
+12 KILL ^TMP("SDWLPL",$JOB),^TMP($JOB,"SDWLPL")
+13 DO INIT^SDWLPL(DFN,"M")
+14 IF '$DATA(^TMP($JOB,"SDWLPL"))
QUIT
+15 DO LIST^SDWLPL("M",DFN)
+16 FOR
IF '$DATA(^TMP($JOB,"SDWLPL"))
QUIT
NEW SDR
DO ANSW^SDWLEVAL(1,.SDR)
IF 'SDR
DO LIST^SDWLPL("M",DFN)
Begin DoDot:2
+17 FOR
NEW SDR
DO ANSW^SDWLEVAL(0,.SDR)
IF '$DATA(^TMP($JOB,"SDWLPL"))
QUIT
IF 'SDR
WRITE !,"MUST ENTER A REASON NOT TO DISPOSITION MATCHED EWL ENTRY",!
End DoDot:2
End DoDot:1
+18 IF $DATA(^TMP($JOB,"APPT"))
NEW SDEV
DO EN^SDWLEVAL(DFN,.SDEV)
IF SDEV
IF $LENGTH(SDEV(1))>0
Begin DoDot:1
+19 ;display and process selected open EWL entries
IF '$DATA(^TMP($JOB,"SDWLPL"))
QUIT
DO ASKREM^SDWLEVAL
SET SDCTN=1
+20 QUIT
End DoDot:1
+21 QUIT
+22 ;
DATE ; -- change date range
+1 SET VALMB=SDBEG
DO RANGE^VALM11
+2 IF $SELECT('VALMBEG:1,SDBEG'=VALMBEG:0,1:SDEND=VALMEND)
WRITE !!,"Date range was not changed."
DO PAUSE^VALM1
SET VALMBCK=""
GOTO DATEQ
+3 SET SDBEG=VALMBEG
SET SDEND=VALMEND
+4 IF SDAMTYP="P"
DO BLD^SDAM1
+5 IF SDAMTYP="C"
DO BLD^SDAM3
+6 SET VALMBCK="R"
DATEQ KILL VALMB,VALMBEG,VALMEND
QUIT
+1 ;
INP(DFN,VDATE) ; -- determine inpat status ; dom is not an inpat appt
+1 NEW SDINP,VAINDT,VADMVT
+2 SET SDINP=""
SET VAINDT=VDATE
DO ADM^VADPT2
IF 'VADMVT
GOTO INPQ
+3 IF $PIECE(^DG(43,1,0),U,21)
IF $PIECE($GET(^DIC(42,+$PIECE($GET(^DGPM(VADMVT,0)),U,6),0)),U,3)="D"
GOTO INPQ
+4 SET SDINP="I"
INPQ QUIT SDINP
+1 ;
VALID(DFN,SDCL,SDT,SDDA) ; -- return valid appt.
+1 ; **NOTE: For speed consideration the ^SC and ^DPT nodes must be
+2 ; check to see they exist prior to calling this entry point.
+3 ; input: DFN := ifn of pat.
+4 ; SDT := appt d/t
+5 ; SDCL := ifn of clinic
+6 ; SDDA := ifn of appt
+7 ; output: [returned] := 1 for valid appt., 0 for not valid
+8 QUIT $SELECT($PIECE(^SC(SDCL,"S",SDT,1,SDDA,0),U,9)'="C":1,$PIECE(^DPT(DFN,"S",SDT,0),U,2)["C":1,1:0)
