Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDAM2

SDAM2.m

Go to the documentation of this file.
  1. SDAM2 ;ALB/MJK - Appt Mgt (cont) ;JAN 15, 2016
  1. ;;5.3;Scheduling;**250,296,327,478,446,627,686**;Aug 13, 1993;Build 53
  1. ;
  1. CI ; -- protocol SDAM APPT CHECK IN entry pt
  1. ; input: VALMY := array entries
  1. ;
  1. N %,SDI,SDAT,VALMY,SDAMCIDT,SDCIACT
  1. D SEL^VALM2 S SDI=0,SDCIACT=""
  1. D NOW^%DTC S SDAMCIDT=$P(%,".")_"."_$E($P(%,".",2)_"0000",1,4)
  1. F S SDI=$O(VALMY(SDI)) Q:'SDI I $D(^TMP("SDAMIDX",$J,SDI)) K SDAT D
  1. .S SDAT=^TMP("SDAMIDX",$J,SDI)
  1. .W !,^TMP("SDAM",$J,+SDAT,0)
  1. .D:VALMCC SELECT^VALM10(+SDAT,1)
  1. .D ONE($P(SDAT,U,2),$P(SDAT,U,4),$P(SDAT,U,3),$P(SDAT,U,5),0,SDAMCIDT)
  1. .D:VALMCC SELECT^VALM10(+SDAT,0)
  1. S VALMBCK=$S(VALMCC:"",1:"R")
  1. Q
  1. ;
  1. ONE(DFN,SDCL,SDT,SDDA,SDASK,SDAMCIDT) ; -- check in one appt
  1. ; input: DFN := ifn of patient
  1. ; SDCL := clinic#
  1. ; SDT := appt d/t
  1. ; SDDA := ifn in ^SC multiple or null
  1. ; SDASK := ask d/t of ci always [1|yes or 0|no]
  1. ; SDAMCIDT := ci date/time [optional]
  1. ;
  1. I $D(XRTL) D T0^%ZOSV
  1. S:'SDDA SDDA=$$FIND(DFN,SDT,SDCL)
  1. I 'SDDA W !!,*7,"You cannot check in this appointment." D PAUSE^VALM1 G ONEQ
  1. N SDATA,SDCIHDL,X S SDATA=SDDA_U_DFN_U_SDT_U_SDCL,SDCIHDL=$$HANDLE^SDAMEVT(1)
  1. D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
  1. I '$D(^SD(409.63,"ACI",1,+SDATA("BEFORE","STATUS"))) W !!,*7,"You cannot check in this appointment." D PAUSE^VALM1 G ONEQ
  1. ; *** mt blocking removed
  1. ;S X="EASMTCHK" X ^%ZOSF("TEST") I $T,$G(EASACT)'="W",$$MT^EASMTCHK(DFN,"","C",SDT) D PAUSE^VALM1 G ONEQ
  1. I $P(SDT,".")>DT W !!,*7,"It is too soon to check in this appointment." D PAUSE^VALM1 G ONEQ
  1. S:'$D(^SC(SDCL,"S",0)) ^(0)="^44.001DA^^"
  1. S DR="",X=$G(^SC(SDCL,"S",SDT,1,SDDA,"C"))
  1. I +X S DR=309
  1. ; -- already co'ed
  1. I DR="",$P(X,U,3) D
  1. .S DR="309//"
  1. .I $P(^SC(SDCL,0),U,24)!(SDASK) S DR=DR_$$FTIME^VALM1($P(X,U,3)) Q
  1. .S DR=DR_"//^S X="_$P(X,U,3)
  1. ;
  1. I DR="",$P(^SC(SDCL,0),U,24)!(SDASK) S DR="309//"_$S(SDAMCIDT:$$FTIME^VALM1(SDAMCIDT),1:"NOW")
  1. I DR="" S DR="309///"_$S(SDAMCIDT:"/"_SDAMCIDT,1:"NOW")
  1. S DA(2)=SDCL,DA(1)=SDT,DA=SDDA,DIE="^SC("_DA(2)_",""S"","_DA(1)_",1," D ^DIE
  1. ;update SDEC APPOINTMENT ;alb/sat 627
  1. N SDECAPPT,SDECDT
  1. S SDECAPPT=$$APPTGET^SDECUTL(DFN,SDT,SDCL)
  1. S SDECDT=$$GET1^DIQ(44.003,SDDA_","_SDT_","_SDCL_",",309,"I")
  1. D SDECCHK^SDEC25(SDECAPPT,SDECDT)
  1. ;alb/sat 627 end addition/modification
  1. D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
  1. 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
  1. I SDATA("BEFORE","STATUS")'=SDATA("AFTER","STATUS") D
  1. .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))
  1. .I $D(SDCIACT) D
  1. ..S Y=SDATA("AFTER","STATUS"),Y1=$P(Y,U,4),Y=$P(Y,U,3)
  1. ..I $P(SDATA("BEFORE","STATUS"),U,3)'=Y D UPD($$LOWER^VALM1(Y),"STAT",+SDAT,1),UPD("","TIME",+SDAT,1)
  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)
  1. .D EVT^SDAMEVT(.SDATA,4,0,SDCIHDL) ; 4 := ci evt , 0 := interactive mode
  1. I $D(XRT0) S XRTN="SDAM2" D T1^%ZOSV
  1. ONEQ K DA,DIE,DR,DQ,DE,Y,Y1 Q
  1. ;
  1. ;
  1. FIND(DFN,SDT,SDCL) ; -- return appt ifn for pat
  1. ; input: DFN := ifn of pat.
  1. ; SDT := appt d/t
  1. ; SDCL := ifn of clinic
  1. ; output: [returned] := ifn if pat has appt on date/time
  1. ;
  1. N Y
  1. ;*zeb+1 686 3/14/19 reverse $O to fix handling of more than one cancelled appointment for a particular patient/time/clinic combo
  1. S Y=99999 F S Y=$O(^SC(SDCL,"S",SDT,1,Y),-1) 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
  1. Q Y
  1. ;
  1. UPD(TEXT,FLD,LINE,SAVE) ; -- update data for screen
  1. D FLDTEXT^VALM10(LINE,FLD,TEXT)
  1. D:VALMCC CNTRL^VALM10(LINE,$P(VALMDDF(FLD),U,2),$P(VALMDDF(FLD),U,3),IOINHI,IOINORM,+$G(SAVE))
  1. Q
  1. ;
  1. MAKE ; -- make appt action
  1. N ORACTION,ORVP,XQORQUIT,SDAMERR
  1. D FULL^VALM1
  1. W !!,VALMHDR(1)
  1. D ^SDM
  1. I '$D(SDAMERR) D BLD^SDAM
  1. I $D(SDAMERR) D PAUSE^VALM1
  1. D SDM^SDKILL S VALMBCK="R"
  1. Q
  1. ;
  1. WI ; -- walk-in visit action
  1. S VALMBCK="R"
  1. D FULL^VALM1
  1. I SDAMTYP="P" I $$CL^SDAMWI(SDFN) D BLD^SDAM1
  1. I SDAMTYP="C" I $$PT^SDAMWI(SDCLN) D BLD^SDAM3
  1. ;evaluate wait list ;SD/327
  1. EWLCHK ;check if patient has any open EWL entries (SD/372)
  1. ;CLN expected as clinic IEN
  1. I '$D(DFN) Q
  1. Q:'$D(SDT)
  1. K ^TMP($J,"SDAMA301"),^TMP($J,"APPT")
  1. N SD S SD=SDT
  1. I '$D(SC) S SC=+$G(CLN)
  1. ;
  1. K ^TMP($J,"SDAMA301"),^TMP($J,"APPT")
  1. W:$D(IOF) @IOF D APPT^SDWLEVAL(DFN,SD,SC)
  1. Q:'$D(^TMP($J,"APPT"))
  1. N SDEV D EN^SDWLEVAL(DFN,.SDEV) I SDEV,$L(SDEV(1))>0 D
  1. .K ^TMP("SDWLPL",$J),^TMP($J,"SDWLPL")
  1. .D INIT^SDWLPL(DFN,"M")
  1. .Q:'$D(^TMP($J,"SDWLPL"))
  1. .D LIST^SDWLPL("M",DFN)
  1. .F Q:'$D(^TMP($J,"SDWLPL")) N SDR D ANSW^SDWLEVAL(1,.SDR) I 'SDR D LIST^SDWLPL("M",DFN) D
  1. ..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",!
  1. I $D(^TMP($J,"APPT")) N SDEV D EN^SDWLEVAL(DFN,.SDEV) I SDEV,$L(SDEV(1))>0 D
  1. .Q:'$D(^TMP($J,"SDWLPL")) D ASKREM^SDWLEVAL S SDCTN=1 ;display and process selected open EWL entries
  1. .Q
  1. Q
  1. ;
  1. DATE ; -- change date range
  1. S VALMB=SDBEG D RANGE^VALM11
  1. I $S('VALMBEG:1,SDBEG'=VALMBEG:0,1:SDEND=VALMEND) W !!,"Date range was not changed." D PAUSE^VALM1 S VALMBCK="" G DATEQ
  1. S SDBEG=VALMBEG,SDEND=VALMEND
  1. I SDAMTYP="P" D BLD^SDAM1
  1. I SDAMTYP="C" D BLD^SDAM3
  1. S VALMBCK="R"
  1. DATEQ K VALMB,VALMBEG,VALMEND Q
  1. ;
  1. INP(DFN,VDATE) ; -- determine inpatient status ; dom is not an inpatient appt
  1. N SDINP,VAINDT,VADMVT
  1. S SDINP="",VAINDT=VDATE D ADM^VADPT2 G INPQ:'VADMVT
  1. 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
  1. S SDINP="I"
  1. INPQ Q SDINP
  1. ;
  1. VALID(DFN,SDCL,SDT,SDDA) ; -- return valid appt.
  1. ; **NOTE: For speed consideration the ^SC and ^DPT nodes must be
  1. ; check to see they exist prior to calling this entry point.
  1. ; input: DFN := ifn of pat.
  1. ; SDT := appt d/t
  1. ; SDCL := ifn of clinic
  1. ; SDDA := ifn of appt
  1. ; output: [returned] := 1 for valid appt., 0 for not valid
  1. 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)