- 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 Feb 19, 2025@00:06:43 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 ;
