Routine: SCMCMU3

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

UNLOCK(NODE) ; -- unlock node

 L -@NODE

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

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

SCMCMU3.m