SCMCEV3 ;ALB/CMM - TEAM EVENT DRIVER UTILITIES ; 03/20/96
;;5.3;Scheduling;**41**;AUG 13, 1993
;
INVOKE(DFN) ;envokes Team Event Driver
I '$D(^TMP($J,"SC CED",DFN,"BEFORE"))!('$D(^TMP($J,"SC CED",DFN,"AFTER"))) G EXIT
S X=+$O(^ORD(101,"B","SC CLINIC ENROLL/DISCHARGE EVENT DRIVER",0))_";ORD(101,"
D EN^XQOR
EXIT ;
K ^TMP($J,"SC CED",DFN,"BEFORE"),^TMP($J,"SC CED",DFN,"AFTER"),X
Q
;
BEFORE(DFN) ;
;get before picture of ^DPT(DFN,"DE") node
;
K ^TMP($J,"SC CED",DFN,"BEFORE")
MERGE ^TMP($J,"SC CED",DFN,"BEFORE")=^DPT(DFN,"DE")
I '$D(^TMP($J,"SC CED",DFN,"BEFORE")) S ^TMP($J,"SC CED",DFN,"BEFORE")=""
; ^ not enrolled in any clinics ever
Q
;
AFTER(DFN) ;
;get after picture of ^DPT(DFN,"DE") node
;
K ^TMP($J,"SC CED",DFN,"AFTER")
MERGE ^TMP($J,"SC CED",DFN,"AFTER")=^DPT(DFN,"DE")
Q
;
COMPARE(DFN) ;team event driver
;compare before and after of DFN's "DE" node
N NXT,SUB1,SUB2,NEW,CLN,ENT
S (NXT,SUB1,SUB2)=0
I '$D(^TMP($J,"SC CED",DFN,"AFTER")) G DELS
F S NXT=$O(^TMP($J,"SC CED",DFN,"AFTER",NXT)) Q:NXT=""!(NXT'?.N) D
.S NEW=0
.;check clinic added
.I '$D(^TMP($J,"SC CED",DFN,"BEFORE",NXT,0)) D NEWC(DFN,NXT) S NEW=1
.Q:NEW
.S SUB1=0
.;change to existing entry
.F S SUB1=$O(^TMP($J,"SC CED",DFN,"AFTER",NXT,SUB1)) Q:SUB1=""!(SUB1'?.N) D
..S SUB2=0
..F S SUB2=$O(^TMP($J,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2)) Q:SUB2=""!(SUB2'?.N) D
...I $G(^TMP($J,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2,0))'=$G(^TMP($J,"SC CED",DFN,"BEFORE",NXT,SUB1,SUB2,0)) D CHNG(DFN,NXT,SUB1,SUB2)
;
DELS ;look for deletes
S CLN=""
F S CLN=$O(^TMP($J,"SC CED",DFN,"BEFORE","B",CLN)) Q:CLN="" D
.S ENT=$O(^TMP($J,"SC CED",DFN,"BEFORE","B",CLN,""))
.Q:ENT=""
.I '$D(^TMP($J,"SC CED",DFN,"AFTER","B",CLN,ENT)) D DELT^SCMCEV1(DFN,CLN)
Q
;
CHNG(DFN,NXT,SUB1,SUB2) ;
;changes made in entry SUB2 of SUB1 entry of entry NXT of "DE" node
N FLAG,EDATE,GDATE,CIEN,CHECK,ENROL,CNAME
S (ENROL,FLAG,GDATE)=0
I $P($G(^TMP($J,"SC CED",DFN,"BEFORE",NXT,SUB1,SUB2,0)),"^")'=$P($G(^TMP($J,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2,0)),"^") S EDATE=$P($G(^TMP($J,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2,0)),"^"),FLAG=1,ENROL=1,EDATE=$P(EDATE,".")
; ^ date only
;enroll date changed
I $P($G(^TMP($J,"SC CED",DFN,"BEFORE",NXT,SUB1,SUB2,0)),"^",3)'=$P($G(^TMP($J,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2,0)),"^",3) S GDATE=$P($G(^TMP($J,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2,0)),"^",3),FLAG=1,ENROL=$S(ENROL=1:3,1:2),GDATE=$P(GDATE,".")
; ^ date only
;discharge date changed/added
S CHECK=""
S CIEN=+$P($G(^TMP($J,"SC CED",DFN,"AFTER",NXT,0)),"^") ;clinic ien
S CNAME=$P($G(^SC(CIEN,0)),"^") ;clinic name
I $D(EDATE),EDATE=""!(EDATE=0) D DELT^SCMCEV1(DFN,CIEN) Q
; ^ deleted enrollment date
I $D(GDATE),'$D(EDATE) S EDATE=$P($G(^TMP($J,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2,0)),"^"),EDATE=$P(EDATE,".") ;date only
I $D(GDATE),EDATE=GDATE D DELT^SCMCEV1(DFN,CIEN) Q
; ^ enrolled and discharged on same date
I GDATE'="",ENROL=1 S ENROL=3
I GDATE'="",ENROL=1 S ENROL=2
;enrol = 1:enrollment ; 2=discharge ; 3=both
I FLAG S CHECK=$$CHK^SCMCEV2(DFN,CIEN,ENROL)
;update 404.42?
I +CHECK D UPDATE^SCMCEV1(DFN,$P(CHECK,"^",2),EDATE,GDATE,CNAME)
Q
;
NEWC(DFN,NXT) ;
;new clinic added (enrolled)
;DFN - patient ien
;NXT - ien of "DE" node
;
N CIEN,NODE,CHKIT,SUB1,EDATE,GDATE,FLG,CNAME,SCRESTA,SCREST
S NODE=$G(^TMP($J,"SC CED",DFN,"AFTER",NXT,0))
Q:NODE=""
S CIEN=$P(NODE,"^") ;clinic ien
S CNAME=$P($G(^SC(+CIEN,0)),"^") ;clinic name
S SUB1=$O(^TMP($J,"SC CED",DFN,"AFTER",NXT,0))
S SUB2=$O(^TMP($J,"SC CED",DFN,"AFTER",NXT,SUB1,"A"),-1)
S EDATE=$P($G(^TMP($J,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2,0)),"^"),FLG=1
S EDATE=$P(EDATE,".") ;date only
S GDATE=$P($G(^TMP($J,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2,0)),"^",3)
S GDATE=$P(GDATE,".") ;date only
I GDATE'="" S FLG=3
; -- This fires off MailMessage for new assignment to Clinic
S SCREST=$$RESTPT^SCAPMCU4(DFN,DT,"SCRESTA")
D:SCREST MAIL^SCMCCON(DFN,.CNAME,1,EDATE,"SCRESTA")
; --- ----
S CHKIT=$$CHK^SCMCEV2(DFN,CIEN,FLG)
I +CHKIT D ENROLL^SCMCEV1(DFN,$P(CHKIT,"^",2),EDATE,GDATE,CNAME)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCEV3 4203 printed Dec 13, 2024@02:40:16 Page 2
SCMCEV3 ;ALB/CMM - TEAM EVENT DRIVER UTILITIES ; 03/20/96
+1 ;;5.3;Scheduling;**41**;AUG 13, 1993
+2 ;
INVOKE(DFN) ;envokes Team Event Driver
+1 IF '$DATA(^TMP($JOB,"SC CED",DFN,"BEFORE"))!('$DATA(^TMP($JOB,"SC CED",DFN,"AFTER")))
GOTO EXIT
+2 SET X=+$ORDER(^ORD(101,"B","SC CLINIC ENROLL/DISCHARGE EVENT DRIVER",0))_";ORD(101,"
+3 DO EN^XQOR
EXIT ;
+1 KILL ^TMP($JOB,"SC CED",DFN,"BEFORE"),^TMP($JOB,"SC CED",DFN,"AFTER"),X
+2 QUIT
+3 ;
BEFORE(DFN) ;
+1 ;get before picture of ^DPT(DFN,"DE") node
+2 ;
+3 KILL ^TMP($JOB,"SC CED",DFN,"BEFORE")
+4 MERGE ^TMP($JOB,"SC CED",DFN,"BEFORE")=^DPT(DFN,"DE")
+5 IF '$DATA(^TMP($JOB,"SC CED",DFN,"BEFORE"))
SET ^TMP($JOB,"SC CED",DFN,"BEFORE")=""
+6 ; ^ not enrolled in any clinics ever
+7 QUIT
+8 ;
AFTER(DFN) ;
+1 ;get after picture of ^DPT(DFN,"DE") node
+2 ;
+3 KILL ^TMP($JOB,"SC CED",DFN,"AFTER")
+4 MERGE ^TMP($JOB,"SC CED",DFN,"AFTER")=^DPT(DFN,"DE")
+5 QUIT
+6 ;
COMPARE(DFN) ;team event driver
+1 ;compare before and after of DFN's "DE" node
+2 NEW NXT,SUB1,SUB2,NEW,CLN,ENT
+3 SET (NXT,SUB1,SUB2)=0
+4 IF '$DATA(^TMP($JOB,"SC CED",DFN,"AFTER"))
GOTO DELS
+5 FOR
SET NXT=$ORDER(^TMP($JOB,"SC CED",DFN,"AFTER",NXT))
if NXT=""!(NXT'?.N)
QUIT
Begin DoDot:1
+6 SET NEW=0
+7 ;check clinic added
+8 IF '$DATA(^TMP($JOB,"SC CED",DFN,"BEFORE",NXT,0))
DO NEWC(DFN,NXT)
SET NEW=1
+9 if NEW
QUIT
+10 SET SUB1=0
+11 ;change to existing entry
+12 FOR
SET SUB1=$ORDER(^TMP($JOB,"SC CED",DFN,"AFTER",NXT,SUB1))
if SUB1=""!(SUB1'?.N)
QUIT
Begin DoDot:2
+13 SET SUB2=0
+14 FOR
SET SUB2=$ORDER(^TMP($JOB,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2))
if SUB2=""!(SUB2'?.N)
QUIT
Begin DoDot:3
+15 IF $GET(^TMP($JOB,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2,0))'=$GET(^TMP($JOB,"SC CED",DFN,"BEFORE",NXT,SUB1,SUB2,0))
DO CHNG(DFN,NXT,SUB1,SUB2)
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;
DELS ;look for deletes
+1 SET CLN=""
+2 FOR
SET CLN=$ORDER(^TMP($JOB,"SC CED",DFN,"BEFORE","B",CLN))
if CLN=""
QUIT
Begin DoDot:1
+3 SET ENT=$ORDER(^TMP($JOB,"SC CED",DFN,"BEFORE","B",CLN,""))
+4 if ENT=""
QUIT
+5 IF '$DATA(^TMP($JOB,"SC CED",DFN,"AFTER","B",CLN,ENT))
DO DELT^SCMCEV1(DFN,CLN)
End DoDot:1
+6 QUIT
+7 ;
CHNG(DFN,NXT,SUB1,SUB2) ;
+1 ;changes made in entry SUB2 of SUB1 entry of entry NXT of "DE" node
+2 NEW FLAG,EDATE,GDATE,CIEN,CHECK,ENROL,CNAME
+3 SET (ENROL,FLAG,GDATE)=0
+4 IF $PIECE($GET(^TMP($JOB,"SC CED",DFN,"BEFORE",NXT,SUB1,SUB2,0)),"^")'=$PIECE($GET(^TMP($JOB,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2,0)),"^")
SET EDATE=$PIECE($GET(^TMP($JOB,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2,0)),"^")
SET FLAG=1
SET ENROL=1
SET EDATE=$PIECE(EDATE,".")
+5 ; ^ date only
+6 ;enroll date changed
+7 IF $PIECE($GET(^TMP($JOB,"SC CED",DFN,"BEFORE",NXT,SUB1,SUB2,0)),"^",3)'=$PIECE($GET(^TMP($JOB,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2,0)),"^",3)
SET GDATE=$PIECE($GET(^TMP($JOB,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2,0)),"^",3)
SET FLAG=1
SET ENROL=$SELECT(ENROL=1:3,1:2)
SET GDATE=$PIECE(GDATE,".")
+8 ; ^ date only
+9 ;discharge date changed/added
+10 SET CHECK=""
+11 ;clinic ien
SET CIEN=+$PIECE($GET(^TMP($JOB,"SC CED",DFN,"AFTER",NXT,0)),"^")
+12 ;clinic name
SET CNAME=$PIECE($GET(^SC(CIEN,0)),"^")
+13 IF $DATA(EDATE)
IF EDATE=""!(EDATE=0)
DO DELT^SCMCEV1(DFN,CIEN)
QUIT
+14 ; ^ deleted enrollment date
+15 ;date only
IF $DATA(GDATE)
IF '$DATA(EDATE)
SET EDATE=$PIECE($GET(^TMP($JOB,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2,0)),"^")
SET EDATE=$PIECE(EDATE,".")
+16 IF $DATA(GDATE)
IF EDATE=GDATE
DO DELT^SCMCEV1(DFN,CIEN)
QUIT
+17 ; ^ enrolled and discharged on same date
+18 IF GDATE'=""
IF ENROL=1
SET ENROL=3
+19 IF GDATE'=""
IF ENROL=1
SET ENROL=2
+20 ;enrol = 1:enrollment ; 2=discharge ; 3=both
+21 IF FLAG
SET CHECK=$$CHK^SCMCEV2(DFN,CIEN,ENROL)
+22 ;update 404.42?
+23 IF +CHECK
DO UPDATE^SCMCEV1(DFN,$PIECE(CHECK,"^",2),EDATE,GDATE,CNAME)
+24 QUIT
+25 ;
NEWC(DFN,NXT) ;
+1 ;new clinic added (enrolled)
+2 ;DFN - patient ien
+3 ;NXT - ien of "DE" node
+4 ;
+5 NEW CIEN,NODE,CHKIT,SUB1,EDATE,GDATE,FLG,CNAME,SCRESTA,SCREST
+6 SET NODE=$GET(^TMP($JOB,"SC CED",DFN,"AFTER",NXT,0))
+7 if NODE=""
QUIT
+8 ;clinic ien
SET CIEN=$PIECE(NODE,"^")
+9 ;clinic name
SET CNAME=$PIECE($GET(^SC(+CIEN,0)),"^")
+10 SET SUB1=$ORDER(^TMP($JOB,"SC CED",DFN,"AFTER",NXT,0))
+11 SET SUB2=$ORDER(^TMP($JOB,"SC CED",DFN,"AFTER",NXT,SUB1,"A"),-1)
+12 SET EDATE=$PIECE($GET(^TMP($JOB,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2,0)),"^")
SET FLG=1
+13 ;date only
SET EDATE=$PIECE(EDATE,".")
+14 SET GDATE=$PIECE($GET(^TMP($JOB,"SC CED",DFN,"AFTER",NXT,SUB1,SUB2,0)),"^",3)
+15 ;date only
SET GDATE=$PIECE(GDATE,".")
+16 IF GDATE'=""
SET FLG=3
+17 ; -- This fires off MailMessage for new assignment to Clinic
+18 SET SCREST=$$RESTPT^SCAPMCU4(DFN,DT,"SCRESTA")
+19 if SCREST
DO MAIL^SCMCCON(DFN,.CNAME,1,EDATE,"SCRESTA")
+20 ; --- ----
+21 SET CHKIT=$$CHK^SCMCEV2(DFN,CIEN,FLG)
+22 IF +CHKIT
DO ENROLL^SCMCEV1(DFN,$PIECE(CHKIT,"^",2),EDATE,GDATE,CNAME)
+23 QUIT
+24 ;
