SCMCMU3 ;ALB/MJK - Discharge Patient from Clinic ; 1/27/05 9:55am
;;5.3;Scheduling;**148,157,346,1015**;AUG 13, 1993;Build 21
;
EN(DFN,SCCLN,SCDATE,SCREA) ; -- main entry point
N SCENR,SCENR0,SCRET
S SCENR=+$O(^DPT(DFN,"DE","B",+SCCLN,0))
;
; -- quit pateint never enrolled in clinic
IF 'SCENR G ENQ
;
S SCENR0=$G(^DPT(DFN,"DE",SCENR,0))
;
; -- quit if enrollment is currently inactive
IF $P(SCENR0,U,2)'="" G ENQ
;
D BEFORE^SCMCEV3(DFN) ;setup before values
;
S SCRET=$$DISCH(DFN,SCCLN,SCDATE,SCENR,SCREA)
IF SCRET=1 D
. D AFTER^SCMCEV3(DFN) ;setup after values
. D INVOKE^SCMCEV3(DFN) ; call event driver
ENQ Q $G(SCRET,$$ERR(3))
;
DISCH(DFN,SCCLN,SCDATE,SCENR,SCREA) ; -- discharge from clinic
;initialize variables
N SCDT,SCDT0,SCDAT,SCDAT0,DIE,DA,DR,Y,SCNODE,SCRET,SCARRAY,SCCOUNT
K ^TMP($J,"SDAMA301")
; -- check for future apps
S SCDT=DT+1
I $G(SCCLN)'="",$G(DFN)'="" D
.;setup call to SDAPI to retrieve a single future appt
.S SCARRAY(1)=SCDT,SCARRAY(2)=SCCLN,SCARRAY(3)="R;I"
.S SCARRAY(4)=DFN,SCARRAY("FLDS")=4,SCARRAY("MAX")=1
.S SCCOUNT=$$SDAPI^SDAMA301(.SCARRAY)
.K ^TMP($J,"SDAMA301")
;if a future appointment returned
I SCCOUNT>0 D
.S SCRET=2
;if no future appointments exist
I SCCOUNT'>0 D
.S SCDAT=0
.F S SCDAT=$O(^DPT(DFN,"DE",SCENR,1,SCDAT)) Q:'SCDAT D
.. S SCDAT0=$G(^DPT(DFN,"DE",SCENR,1,SCDAT,0))
.. I $P(SCDAT0,U,3)]"" Q
.. S SCNODE=$NA(^DPT(DFN,"DE",SCENR,1,SCDAT))
.. D LOCK(SCNODE)
.. S DA(2)=DFN,DA(1)=SCENR
.. S DIE="^DPT("_DFN_",""DE"","_SCENR_",1,",DA=SCDAT
.. S DR="3////"_SCDATE_";4////"_SCREA
.. D ^DIE
.. D UNLOCK(SCNODE)
.. S SCRET=1
;
DISCHQ Q $$ERR($G(SCRET,3))
;
LOCK(NODE) ; -- lock node
F L +@NODE:5 IF $T Q
Q
;
UNLOCK(NODE) ; -- unlock node
L -@NODE
Q
;
ERR(CODE) ;
Q $P($TEXT(RET+CODE),";;",2)
;
;
; piece [ return code ^ error text ]
RET ; -- return values
;;1^Patient successfully discharged from clinic
;;2^Patient has future appointments in clinic
;;3^No active enrollment data for clinic
;
TEST ;
W !!,$$EN(7170643,446,DT,"TEST FROM SCMCMU3")
Q
SCMCMU3 ;ALB/MJK - Discharge Patient from Clinic ; 1/27/05 9:55am
+1 ;;5.3;Scheduling;**148,157,346,1015**;AUG 13, 1993;Build 21
+2 ;
EN(DFN,SCCLN,SCDATE,SCREA) ; -- main entry point
+1 NEW SCENR,SCENR0,SCRET
+2 SET SCENR=+$ORDER(^DPT(DFN,"DE","B",+SCCLN,0))
+3 ;
+4 ; -- quit pateint never enrolled in clinic
+5 IF 'SCENR
GOTO ENQ
+6 ;
+7 SET SCENR0=$GET(^DPT(DFN,"DE",SCENR,0))
+8 ;
+9 ; -- quit if enrollment is currently inactive
+10 IF $PIECE(SCENR0,U,2)'=""
GOTO ENQ
+11 ;
+12 ;setup before values
DO BEFORE^SCMCEV3(DFN)
+13 ;
+14 SET SCRET=$$DISCH(DFN,SCCLN,SCDATE,SCENR,SCREA)
+15 IF SCRET=1
Begin DoDot:1
+16 ;setup after values
DO AFTER^SCMCEV3(DFN)
+17 ; call event driver
DO INVOKE^SCMCEV3(DFN)
End DoDot:1
ENQ QUIT $GET(SCRET,$$ERR(3))
+1 ;
DISCH(DFN,SCCLN,SCDATE,SCENR,SCREA) ; -- discharge from clinic
+1 ;initialize variables
+2 NEW SCDT,SCDT0,SCDAT,SCDAT0,DIE,DA,DR,Y,SCNODE,SCRET,SCARRAY,SCCOUNT
+3 KILL ^TMP($JOB,"SDAMA301")
+4 ; -- check for future apps
+5 SET SCDT=DT+1
+6 IF $GET(SCCLN)'=""
IF $GET(DFN)'=""
Begin DoDot:1
+7 ;setup call to SDAPI to retrieve a single future appt
+8 SET SCARRAY(1)=SCDT
SET SCARRAY(2)=SCCLN
SET SCARRAY(3)="R;I"
+9 SET SCARRAY(4)=DFN
SET SCARRAY("FLDS")=4
SET SCARRAY("MAX")=1
+10 SET SCCOUNT=$$SDAPI^SDAMA301(.SCARRAY)
+11 KILL ^TMP($JOB,"SDAMA301")
End DoDot:1
+12 ;if a future appointment returned
+13 IF SCCOUNT>0
Begin DoDot:1
+14 SET SCRET=2
End DoDot:1
+15 ;if no future appointments exist
+16 IF SCCOUNT'>0
Begin DoDot:1
+17 SET SCDAT=0
+18 FOR
SET SCDAT=$ORDER(^DPT(DFN,"DE",SCENR,1,SCDAT))
IF 'SCDAT
QUIT
Begin DoDot:2
+19 SET SCDAT0=$GET(^DPT(DFN,"DE",SCENR,1,SCDAT,0))
+20 IF $PIECE(SCDAT0,U,3)]""
QUIT
+21 SET SCNODE=$NAME(^DPT(DFN,"DE",SCENR,1,SCDAT))
+22 DO LOCK(SCNODE)
+23 SET DA(2)=DFN
SET DA(1)=SCENR
+24 SET DIE="^DPT("_DFN_",""DE"","_SCENR_",1,"
SET DA=SCDAT
+25 SET DR="3////"_SCDATE_";4////"_SCREA
+26 DO ^DIE
+27 DO UNLOCK(SCNODE)
+28 SET SCRET=1
End DoDot:2
End DoDot:1
+29 ;
DISCHQ QUIT $$ERR($GET(SCRET,3))
+1 ;
LOCK(NODE) ; -- lock node
+1 FOR
LOCK +@NODE:5
IF $TEST
QUIT
+2 QUIT
+3 ;
UNLOCK(NODE) ; -- unlock node
+1 LOCK -@NODE
+2 QUIT
+3 ;
ERR(CODE) ;
+1 QUIT $PIECE($TEXT(RET+CODE),";;",2)
+2 ;
+3 ;
+4 ; piece [ return code ^ error text ]
RET ; -- return values
+1 ;;1^Patient successfully discharged from clinic
+2 ;;2^Patient has future appointments in clinic
+3 ;;3^No active enrollment data for clinic
+4 ;
TEST ;
+1 WRITE !!,$$EN(7170643,446,DT,"TEST FROM SCMCMU3")
+2 QUIT
