source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDAM2.m@ 899

Last change on this file since 899 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.7 KB
Line 
1SDAM2 ;ALB/MJK - Appt Mgt (cont); 8/18/05 12:10pm ; Compiled April 16, 2007 09:43:32
2 ;;5.3;Scheduling;**250,296,327,478,446**;Aug 13, 1993;Build 77
3 ;
4CI ; -- protocol SDAM APPT CHECK IN entry pt
5 ; input: VALMY := array entries
6 ;
7 N %,SDI,SDAT,VALMY,SDAMCIDT,SDCIACT
8 D SEL^VALM2 S SDI=0,SDCIACT=""
9 D NOW^%DTC S SDAMCIDT=$P(%,".")_"."_$E($P(%,".",2)_"0000",1,4)
10 F S SDI=$O(VALMY(SDI)) Q:'SDI I $D(^TMP("SDAMIDX",$J,SDI)) K SDAT D
11 .S SDAT=^TMP("SDAMIDX",$J,SDI)
12 .W !,^TMP("SDAM",$J,+SDAT,0)
13 .D:VALMCC SELECT^VALM10(+SDAT,1)
14 .D ONE($P(SDAT,U,2),$P(SDAT,U,4),$P(SDAT,U,3),$P(SDAT,U,5),0,SDAMCIDT)
15 .D:VALMCC SELECT^VALM10(+SDAT,0)
16 S VALMBCK=$S(VALMCC:"",1:"R")
17 Q
18 ;
19ONE(DFN,SDCL,SDT,SDDA,SDASK,SDAMCIDT) ; -- check in one appt
20 ; input: DFN := ifn of patient
21 ; SDCL := clinic#
22 ; SDT := appt d/t
23 ; SDDA := ifn in ^SC multiple or null
24 ; SDASK := ask d/t of ci always [1|yes or 0|no]
25 ; SDAMCIDT := ci date/time [optional]
26 ;
27 I $D(XRTL) D T0^%ZOSV
28 S:'SDDA SDDA=$$FIND(DFN,SDT,SDCL)
29 I 'SDDA W !!,*7,"You cannot check in this appointment." D PAUSE^VALM1 G ONEQ
30 N SDATA,SDCIHDL,X S SDATA=SDDA_U_DFN_U_SDT_U_SDCL,SDCIHDL=$$HANDLE^SDAMEVT(1)
31 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
32 I '$D(^SD(409.63,"ACI",1,+SDATA("BEFORE","STATUS"))) W !!,*7,"You cannot check in this appointment." D PAUSE^VALM1 G ONEQ
33 ; *** mt blocking removed
34 ;S X="EASMTCHK" X ^%ZOSF("TEST") I $T,$G(EASACT)'="W",$$MT^EASMTCHK(DFN,"","C",SDT) D PAUSE^VALM1 G ONEQ
35 I $P(SDT,".")>DT W !!,*7,"It is too soon to check in this appointment." D PAUSE^VALM1 G ONEQ
36 S:'$D(^SC(SDCL,"S",0)) ^(0)="^44.001DA^^"
37 S DR="",X=$G(^SC(SDCL,"S",SDT,1,SDDA,"C"))
38 I +X S DR=309
39 ; -- already co'ed
40 I DR="",$P(X,U,3) D
41 .S DR="309//"
42 .I $P(^SC(SDCL,0),U,24)!(SDASK) S DR=DR_$$FTIME^VALM1($P(X,U,3)) Q
43 .S DR=DR_"//^S X="_$P(X,U,3)
44 ;
45 I DR="",$P(^SC(SDCL,0),U,24)!(SDASK) S DR="309//"_$S(SDAMCIDT:$$FTIME^VALM1(SDAMCIDT),1:"NOW")
46 I DR="" S DR="309///"_$S(SDAMCIDT:"/"_SDAMCIDT,1:"NOW")
47 S DA(2)=SDCL,DA(1)=SDT,DA=SDDA,DIE="^SC("_DA(2)_",""S"","_DA(1)_",1," D ^DIE
48 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
49 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
50 I SDATA("BEFORE","STATUS")'=SDATA("AFTER","STATUS") D
51 .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))
52 .I $D(SDCIACT) D
53 ..S Y=SDATA("AFTER","STATUS"),Y1=$P(Y,U,4),Y=$P(Y,U,3)
54 ..I $P(SDATA("BEFORE","STATUS"),U,3)'=Y D UPD($$LOWER^VALM1(Y),"STAT",+SDAT,1),UPD("","TIME",+SDAT,1)
55 ..I $P(SDATA("AFTER","STATUS"),U,3)["CHECKED IN" D UPD($S($P(Y1,".")=DT:$$TIME^SDAM1($P(Y1,".",2)),1:" "),"TIME",+SDAT,1)
56 .D EVT^SDAMEVT(.SDATA,4,0,SDCIHDL) ; 4 := ci evt , 0 := interactive mode
57 I $D(XRT0) S XRTN="SDAM2" D T1^%ZOSV
58ONEQ K DA,DIE,DR,DQ,DE,Y,Y1 Q
59 ;
60 ;
61FIND(DFN,SDT,SDCL) ; -- return appt ifn for pat
62 ; input: DFN := ifn of pat.
63 ; SDT := appt d/t
64 ; SDCL := ifn of clinic
65 ; output: [returned] := ifn if pat has appt on date/time
66 ;
67 N Y
68 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
69 Q Y
70 ;
71UPD(TEXT,FLD,LINE,SAVE) ; -- update data for screen
72 D FLDTEXT^VALM10(LINE,FLD,TEXT)
73 D:VALMCC CNTRL^VALM10(LINE,$P(VALMDDF(FLD),U,2),$P(VALMDDF(FLD),U,3),IOINHI,IOINORM,+$G(SAVE))
74 Q
75 ;
76MAKE ; -- make appt action
77 N ORACTION,ORVP,XQORQUIT,SDAMERR
78 D FULL^VALM1
79 W !!,VALMHDR(1)
80 D ^SDM
81 I '$D(SDAMERR) D BLD^SDAM
82 I $D(SDAMERR) D PAUSE^VALM1
83 D SDM^SDKILL S VALMBCK="R"
84 Q
85 ;
86WI ; -- walk-in visit action
87 S VALMBCK="R"
88 D FULL^VALM1
89 I SDAMTYP="P" I $$CL^SDAMWI(SDFN) D BLD^SDAM1
90 I SDAMTYP="C" I $$PT^SDAMWI(SDCLN) D BLD^SDAM3
91 ;evaluate wait list ;SD/327
92EWLCHK ;check if patient has any open EWL entries (SD/372)
93 ;CLN expected as clinic IEN
94 I '$D(DFN) Q
95 Q:'$D(SDT)
96 K ^TMP($J,"SDAMA301"),^TMP($J,"APPT")
97 N SD S SD=SDT
98 I '$D(SC) S SC=+$G(CLN)
99 ;
100 K ^TMP($J,"SDAMA301"),^TMP($J,"APPT")
101 W:$D(IOF) @IOF D APPT^SDWLEVAL(DFN,SD,SC)
102 Q:'$D(^TMP($J,"APPT"))
103 N SDEV D EN^SDWLEVAL(DFN,.SDEV) I SDEV,$L(SDEV(1))>0 D
104 .K ^TMP("SDWLPL",$J),^TMP($J,"SDWLPL")
105 .D INIT^SDWLPL(DFN,"M")
106 .Q:'$D(^TMP($J,"SDWLPL"))
107 .D LIST^SDWLPL("M",DFN)
108 .F Q:'$D(^TMP($J,"SDWLPL")) N SDR D ANSW^SDWLEVAL(1,.SDR) I 'SDR D LIST^SDWLPL("M",DFN) D
109 ..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",!
110 I $D(^TMP($J,"APPT")) N SDEV D EN^SDWLEVAL(DFN,.SDEV) I SDEV,$L(SDEV(1))>0 D
111 .Q:'$D(^TMP($J,"SDWLPL")) D ASKREM^SDWLEVAL S SDCTN=1 ;display and process selected open EWL entries
112 .Q
113 Q
114 ;
115DATE ; -- change date range
116 S VALMB=SDBEG D RANGE^VALM11
117 I $S('VALMBEG:1,SDBEG'=VALMBEG:0,1:SDEND=VALMEND) W !!,"Date range was not changed." D PAUSE^VALM1 S VALMBCK="" G DATEQ
118 S SDBEG=VALMBEG,SDEND=VALMEND
119 I SDAMTYP="P" D BLD^SDAM1
120 I SDAMTYP="C" D BLD^SDAM3
121 S VALMBCK="R"
122DATEQ K VALMB,VALMBEG,VALMEND Q
123 ;
124INP(DFN,VDATE) ; -- determine inpat status ; dom is not an inpat appt
125 N SDINP,VAINDT,VADMVT
126 S SDINP="",VAINDT=VDATE D ADM^VADPT2 G INPQ:'VADMVT
127 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
128 S SDINP="I"
129INPQ Q SDINP
130 ;
131VALID(DFN,SDCL,SDT,SDDA) ; -- return valid appt.
132 ; **NOTE: For speed consideration the ^SC and ^DPT nodes must be
133 ; check to see they exist prior to calling this entry point.
134 ; input: DFN := ifn of pat.
135 ; SDT := appt d/t
136 ; SDCL := ifn of clinic
137 ; SDDA := ifn of appt
138 ; output: [returned] := 1 for valid appt., 0 for not valid
139 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)
Note: See TracBrowser for help on using the repository browser.