1 | SCMCMU3 ;ALB/MJK - Discharge Patient from Clinic ; 1/27/05 9:55am
|
---|
2 | ;;5.3;Scheduling;**148,157,346**;AUG 13, 1993
|
---|
3 | ;
|
---|
4 | EN(DFN,SCCLN,SCDATE,SCREA) ; -- main entry point
|
---|
5 | N SCENR,SCENR0,SCRET
|
---|
6 | S SCENR=+$O(^DPT(DFN,"DE","B",+SCCLN,0))
|
---|
7 | ;
|
---|
8 | ; -- quit pateint never enrolled in clinic
|
---|
9 | IF 'SCENR G ENQ
|
---|
10 | ;
|
---|
11 | S SCENR0=$G(^DPT(DFN,"DE",SCENR,0))
|
---|
12 | ;
|
---|
13 | ; -- quit if enrollment is currently inactive
|
---|
14 | IF $P(SCENR0,U,2)'="" G ENQ
|
---|
15 | ;
|
---|
16 | D BEFORE^SCMCEV3(DFN) ;setup before values
|
---|
17 | ;
|
---|
18 | S SCRET=$$DISCH(DFN,SCCLN,SCDATE,SCENR,SCREA)
|
---|
19 | IF SCRET=1 D
|
---|
20 | . D AFTER^SCMCEV3(DFN) ;setup after values
|
---|
21 | . D INVOKE^SCMCEV3(DFN) ; call event driver
|
---|
22 | ENQ Q $G(SCRET,$$ERR(3))
|
---|
23 | ;
|
---|
24 | DISCH(DFN,SCCLN,SCDATE,SCENR,SCREA) ; -- discharge from clinic
|
---|
25 | ;initialize variables
|
---|
26 | N SCDT,SCDT0,SCDAT,SCDAT0,DIE,DA,DR,Y,SCNODE,SCRET,SCARRAY,SCCOUNT
|
---|
27 | K ^TMP($J,"SDAMA301")
|
---|
28 | ; -- check for future apps
|
---|
29 | S SCDT=DT+1
|
---|
30 | I $G(SCCLN)'="",$G(DFN)'="" D
|
---|
31 | .;setup call to SDAPI to retrieve a single future appt
|
---|
32 | .S SCARRAY(1)=SCDT,SCARRAY(2)=SCCLN,SCARRAY(3)="R;I"
|
---|
33 | .S SCARRAY(4)=DFN,SCARRAY("FLDS")=4,SCARRAY("MAX")=1
|
---|
34 | .S SCCOUNT=$$SDAPI^SDAMA301(.SCARRAY)
|
---|
35 | .K ^TMP($J,"SDAMA301")
|
---|
36 | ;if a future appointment returned
|
---|
37 | I SCCOUNT>0 D
|
---|
38 | .S SCRET=2
|
---|
39 | ;if no future appointments exist
|
---|
40 | I SCCOUNT'>0 D
|
---|
41 | .S SCDAT=0
|
---|
42 | .F S SCDAT=$O(^DPT(DFN,"DE",SCENR,1,SCDAT)) Q:'SCDAT D
|
---|
43 | .. S SCDAT0=$G(^DPT(DFN,"DE",SCENR,1,SCDAT,0))
|
---|
44 | .. I $P(SCDAT0,U,3)]"" Q
|
---|
45 | .. S SCNODE=$NA(^DPT(DFN,"DE",SCENR,1,SCDAT))
|
---|
46 | .. D LOCK(SCNODE)
|
---|
47 | .. S DA(2)=DFN,DA(1)=SCENR
|
---|
48 | .. S DIE="^DPT("_DFN_",""DE"","_SCENR_",1,",DA=SCDAT
|
---|
49 | .. S DR="3////"_SCDATE_";4////"_SCREA
|
---|
50 | .. D ^DIE
|
---|
51 | .. D UNLOCK(SCNODE)
|
---|
52 | .. S SCRET=1
|
---|
53 | ;
|
---|
54 | DISCHQ Q $$ERR($G(SCRET,3))
|
---|
55 | ;
|
---|
56 | LOCK(NODE) ; -- lock node
|
---|
57 | F L +@NODE:5 IF $T Q
|
---|
58 | Q
|
---|
59 | ;
|
---|
60 | UNLOCK(NODE) ; -- unlock node
|
---|
61 | L -@NODE
|
---|
62 | Q
|
---|
63 | ;
|
---|
64 | ERR(CODE) ;
|
---|
65 | Q $P($TEXT(RET+CODE),";;",2)
|
---|
66 | ;
|
---|
67 | ;
|
---|
68 | ; piece [ return code ^ error text ]
|
---|
69 | RET ; -- return values
|
---|
70 | ;;1^Patient successfully discharged from clinic
|
---|
71 | ;;2^Patient has future appointments in clinic
|
---|
72 | ;;3^No active enrollment data for clinic
|
---|
73 | ;
|
---|
74 | TEST ;
|
---|
75 | W !!,$$EN(7170643,446,DT,"TEST FROM SCMCMU3")
|
---|
76 | Q
|
---|