SCMCEV1.m

SCMCEV1 ;ALB/CMM - TEAM EVENT DRIVER UTILITIES ; 03/20/96

 ;;5.3;Scheduling;**41,130,140,1015**;AUG 13, 1993;Build 21

 ;

ENROLL(DFN,TIEN,ENDATE,DISDATE,CNAME) ;

 ;enroll DFN patient in team TIEN

 ;DFN - patient ien

 ;TIEN - team ien

 ;ENDATE - clinic enrollment date

 ;DISDATE - clinic discharge date

 ;CNAME - clinic name

 ;

 N OKAY,ERR,PUR,SC,SCERR,TNAME,TEXT

 S TNAME=$P($G(^SCTM(404.51,TIEN,0)),"^") ;team name

 S OKAY=$$ACPTTM^SCAPMC6(DFN,TIEN,,ENDATE,"ERR")

 I OKAY=0 Q

 ;okay = ien of 404.42

 S PUR(1,0)="Automatic Team Enrollment/Update via Clinic: "_CNAME

 I '$D(SCERR) D

 .D WP^DIE(404.42,+OKAY_",","1","A","PUR","SCERR")

 .S TEXT="Enrolled in Team: "_TNAME

 .D:'$G(DGQUIET) EN^DDIOL(TEXT,"","!,?10")

 K SCERR,ERR

 I $D(DISDATE) D

 .S PUR(1,0)="Automatic Team Discharge via Clinic: "_CNAME

 .Q:'$$POSASS^SCMCEV2(DFN,TIEN)

 .S OKAY=$$INPTTM^SCAPMC7(DFN,TIEN,DISDATE,"ERR")

 .I OKAY'=0 D

 ..D WP^DIE(404.42,+OKAY_",","1","A","PUR","SCERR")

 ..S TEXT="Discharged from Team: "_TNAME

 ..D:'$G(DGQUIET) EN^DDIOL(TEXT,"","!,?10")

 Q

 ;

UPDATE(DFN,TIEN,EDATE,DDATE,CNAME) ;

 ;update enrollment date/discharge date

 ;DFN - patient ien

 ;TIEN - team ien

 ;EDATE - enrollment date

 ;DDATE - discharge date

 ;CNAME - clinic name

 ;

 N TPA,TDATE,TEXT,TNAME

 S TNAME=$P($G(^SCTM(404.51,TIEN,0)),"^") ;team name

 I '$D(^SCPT(404.42,"AIDT",DFN,TIEN)) D ENROLL(TIEN,DFN,EDATE,DDATE,CNAME) Q

 ; ^ new enrollment

 S TDATE=$O(^SCPT(404.42,"AIDT",DFN,TIEN,"")) ; -team assignment date (most recent)

 S TPA=$O(^SCPT(404.42,"AIDT",DFN,TIEN,TDATE,"")) ; team assignment ien

 Q:'$D(^SCPT(404.42,+TPA,0))

 K SC($J,404.42),SCERR

 I EDATE'=0 D

 .S SC($J,404.42,TPA_",",.13)=DUZ

 .S SC($J,404.42,TPA_",",.14)=DT

 .S SC($J,404.42,TPA_",",.02)=$P(EDATE,".") ;date only

 .D FILE^DIE("","SC($J)","SCERR")

 .S PUR(1,0)="Automatic Team Update via Clinic:  "_CNAME

 .D WP^DIE(404.42,TPA_",","1","A","PUR","SCERR")

 .S TEXT="Update Team Enrollment "_TNAME

 .D:'$G(DGQUIET) EN^DDIOL(TEXT,"","!,?10")

 I +DDATE'=0 D

 .Q:'$$POSASS^SCMCEV2(DFN,TIEN)

 .; ^ assigned to a position

 .S OKAY=$$INPTTM^SCAPMC7(DFN,TPA,DDATE,"ERR") ; discharge from team

 .I OKAY'=0 D

 ..D WP^DIE(404.42,+OKAY_",","1","A","PUR","SCERR")

 ..S TEXT="Discharged from Team: "_TNAME

 ..D:'$G(DGQUIET) EN^DDIOL(TEXT,"","!,?10")

 Q

 ;

DELT(DFN,CLN) ;deleted clinic entry/enrollment date w/'@'

 ;DFN - patient ien

 ;CLN - clinic ien

 ;

 N CHECK,TM,EDATE,OKAY,CNAME,ERR,TEXT,TNAME

 S CNAME=$P($G(^SC(+CLN,0)),"^") ;clinic name

 S CHECK=$$CHK^SCMCEV2(DFN,CLN,2)

 ; ^ auto discharge okay

 Q:'+CHECK

 ;check if assigned to a position on team

 S TM=+$P(CHECK,"^",2) ;team ien

 S OKAY=$$POSASS^SCMCEV2(DFN,TM)

 Q:'OKAY

 ;delete entry

 S ERR=$$DELTE(DFN,TM)

 I ERR D

 .;deleted entry

 .S TNAME=$P($G(^SCTM(404.51,TM,0)),"^") ;team name

 .S TEXT="Deleted team "_TNAME_" assignment due to deleting clinic assignment"

 .D:'$G(DGQUIET) EN^DDIOL(TEXT,"","!,?10")

 Q

 ;

DELTE(DFN,TIEN) ;delete team assignment entry

 ;DFN - patient ien

 ;TIEN - team ien

 N PTA,ADATE,RET

 S RET=1

 S ADATE=$O(^SCPT(404.42,"AIDT",DFN,TIEN,-($$FMADD^XLFDT(DT,1))))

 I ADATE="" S RET=0 G EXD

 S PTA=$O(^SCPT(404.42,"AIDT",DFN,TIEN,ADATE,""))

 I PTA="" S RET=0 G EXD

 S DA=PTA,DIK="^SCPT(404.42,"

 D ^DIK

 K DA,DIK

EXD Q RET

SCMCEV1   ;ALB/CMM - TEAM EVENT DRIVER UTILITIES ; 03/20/96

 +1       ;;5.3;Scheduling;**41,130,140,1015**;AUG 13, 1993;Build 21

 +2       ;

ENROLL(DFN,TIEN,ENDATE,DISDATE,CNAME) ;

 +1       ;enroll DFN patient in team TIEN

 +2       ;DFN - patient ien

 +3       ;TIEN - team ien

 +4       ;ENDATE - clinic enrollment date

 +5       ;DISDATE - clinic discharge date

 +6       ;CNAME - clinic name

 +7       ;

 +8        NEW OKAY,ERR,PUR,SC,SCERR,TNAME,TEXT

 +9       ;team name

           SET TNAME=$PIECE($GET(^SCTM(404.51,TIEN,0)),"^")

 +10       SET OKAY=$$ACPTTM^SCAPMC6(DFN,TIEN,,ENDATE,"ERR")

 +11       IF OKAY=0

               QUIT 

 +12      ;okay = ien of 404.42

 +13       SET PUR(1,0)="Automatic Team Enrollment/Update via Clinic: "_CNAME

 +14       IF '$DATA(SCERR)

               Begin DoDot:1

 +15               DO WP^DIE(404.42,+OKAY_",","1","A","PUR","SCERR")

 +16               SET TEXT="Enrolled in Team: "_TNAME

 +17               IF '$GET(DGQUIET)

                       DO EN^DDIOL(TEXT,"","!,?10")

               End DoDot:1

 +18       KILL SCERR,ERR

 +19       IF $DATA(DISDATE)

               Begin DoDot:1

 +20               SET PUR(1,0)="Automatic Team Discharge via Clinic: "_CNAME

 +21               IF '$$POSASS^SCMCEV2(DFN,TIEN)

                       QUIT 

 +22               SET OKAY=$$INPTTM^SCAPMC7(DFN,TIEN,DISDATE,"ERR")

 +23               IF OKAY'=0

                       Begin DoDot:2

 +24                       DO WP^DIE(404.42,+OKAY_",","1","A","PUR","SCERR")

 +25                       SET TEXT="Discharged from Team: "_TNAME

 +26                       IF '$GET(DGQUIET)

                               DO EN^DDIOL(TEXT,"","!,?10")

                       End DoDot:2

               End DoDot:1

 +27       QUIT 

 +28      ;

UPDATE(DFN,TIEN,EDATE,DDATE,CNAME) ;

 +1       ;update enrollment date/discharge date

 +2       ;DFN - patient ien

 +3       ;TIEN - team ien

 +4       ;EDATE - enrollment date

 +5       ;DDATE - discharge date

 +6       ;CNAME - clinic name

 +7       ;

 +8        NEW TPA,TDATE,TEXT,TNAME

 +9       ;team name

           SET TNAME=$PIECE($GET(^SCTM(404.51,TIEN,0)),"^")

 +10       IF '$DATA(^SCPT(404.42,"AIDT",DFN,TIEN))

               DO ENROLL(TIEN,DFN,EDATE,DDATE,CNAME)

               QUIT 

 +11      ; ^ new enrollment

 +12      ; -team assignment date (most recent)

           SET TDATE=$ORDER(^SCPT(404.42,"AIDT",DFN,TIEN,""))

 +13      ; team assignment ien

           SET TPA=$ORDER(^SCPT(404.42,"AIDT",DFN,TIEN,TDATE,""))

 +14       IF '$DATA(^SCPT(404.42,+TPA,0))

               QUIT 

 +15       KILL SC($JOB,404.42),SCERR

 +16       IF EDATE'=0

               Begin DoDot:1

 +17               SET SC($JOB,404.42,TPA_",",.13)=DUZ

 +18               SET SC($JOB,404.42,TPA_",",.14)=DT

 +19      ;date only

                   SET SC($JOB,404.42,TPA_",",.02)=$PIECE(EDATE,".")

 +20               DO FILE^DIE("","SC($J)","SCERR")

 +21               SET PUR(1,0)="Automatic Team Update via Clinic:  "_CNAME

 +22               DO WP^DIE(404.42,TPA_",","1","A","PUR","SCERR")

 +23               SET TEXT="Update Team Enrollment "_TNAME

 +24               IF '$GET(DGQUIET)

                       DO EN^DDIOL(TEXT,"","!,?10")

               End DoDot:1

 +25       IF +DDATE'=0

               Begin DoDot:1

 +26               IF '$$POSASS^SCMCEV2(DFN,TIEN)

                       QUIT 

 +27      ; ^ assigned to a position

 +28      ; discharge from team

                   SET OKAY=$$INPTTM^SCAPMC7(DFN,TPA,DDATE,"ERR")

 +29               IF OKAY'=0

                       Begin DoDot:2

 +30                       DO WP^DIE(404.42,+OKAY_",","1","A","PUR","SCERR")

 +31                       SET TEXT="Discharged from Team: "_TNAME

 +32                       IF '$GET(DGQUIET)

                               DO EN^DDIOL(TEXT,"","!,?10")

                       End DoDot:2

               End DoDot:1

 +33       QUIT 

 +34      ;

DELT(DFN,CLN) ;deleted clinic entry/enrollment date w/'@'

 +1       ;DFN - patient ien

 +2       ;CLN - clinic ien

 +3       ;

 +4        NEW CHECK,TM,EDATE,OKAY,CNAME,ERR,TEXT,TNAME

 +5       ;clinic name

           SET CNAME=$PIECE($GET(^SC(+CLN,0)),"^")

 +6        SET CHECK=$$CHK^SCMCEV2(DFN,CLN,2)

 +7       ; ^ auto discharge okay

 +8        IF '+CHECK

               QUIT 

 +9       ;check if assigned to a position on team

 +10      ;team ien

           SET TM=+$PIECE(CHECK,"^",2)

 +11       SET OKAY=$$POSASS^SCMCEV2(DFN,TM)

 +12       IF 'OKAY

               QUIT 

 +13      ;delete entry

 +14       SET ERR=$$DELTE(DFN,TM)

 +15       IF ERR

               Begin DoDot:1

 +16      ;deleted entry

 +17      ;team name

                   SET TNAME=$PIECE($GET(^SCTM(404.51,TM,0)),"^")

 +18               SET TEXT="Deleted team "_TNAME_" assignment due to deleting clinic assignment"

 +19               IF '$GET(DGQUIET)

                       DO EN^DDIOL(TEXT,"","!,?10")

               End DoDot:1

 +20       QUIT 

 +21      ;

DELTE(DFN,TIEN) ;delete team assignment entry

 +1       ;DFN - patient ien

 +2       ;TIEN - team ien

 +3        NEW PTA,ADATE,RET

 +4        SET RET=1

 +5        SET ADATE=$ORDER(^SCPT(404.42,"AIDT",DFN,TIEN,-($$FMADD^XLFDT(DT,1))))

 +6        IF ADATE=""

               SET RET=0

               GOTO EXD

 +7        SET PTA=$ORDER(^SCPT(404.42,"AIDT",DFN,TIEN,ADATE,""))

 +8        IF PTA=""

               SET RET=0

               GOTO EXD

 +9        SET DA=PTA

           SET DIK="^SCPT(404.42,"

 +10       DO ^DIK

 +11       KILL DA,DIK

EXD        QUIT RET