| 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
 | 
|---|