source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCMU3.m@ 1476

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1SCMCMU3 ;ALB/MJK - Discharge Patient from Clinic ; 1/27/05 9:55am
2 ;;5.3;Scheduling;**148,157,346**;AUG 13, 1993
3 ;
4EN(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
22ENQ Q $G(SCRET,$$ERR(3))
23 ;
24DISCH(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 ;
54DISCHQ Q $$ERR($G(SCRET,3))
55 ;
56LOCK(NODE) ; -- lock node
57 F L +@NODE:5 IF $T Q
58 Q
59 ;
60UNLOCK(NODE) ; -- unlock node
61 L -@NODE
62 Q
63 ;
64ERR(CODE) ;
65 Q $P($TEXT(RET+CODE),";;",2)
66 ;
67 ;
68 ; piece [ return code ^ error text ]
69RET ; -- 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 ;
74TEST ;
75 W !!,$$EN(7170643,446,DT,"TEST FROM SCMCMU3")
76 Q
Note: See TracBrowser for help on using the repository browser.