SCAPMC15 ;ALB/REW - Team API's ; December 1, 1995
;;5.3;Scheduling;**41**;AUG 13, 1993
;;1.0
ACTMNM(SCTMNM,SCFIELDA,SCMAINA,SCEFF,SCERR) ; -- activate a team (add if need be)
; input:
; SCTMNM = External Value of Team Name
; SCFIELDA= similar to above -used for history entries (404.58)
; SCMAINA = array of extra field entries - scfielda('fld#')=value
; -Note: Only used if BRAND NEW TEAM - team fields (404.51)
; SCEFF = date to activate [default=DT]
; SCERR = array NAME to store error messages.
; [ex. ^TMP("ORXX",$J)]
;
; Output:
; SCPTAIEN = ien if entry made to file 404.43, 0 ow
; SCERR() = Array of DIALOG file messages(errors) .
; Foramt:
; Subscript: Sequential # from 1 to n
; Piece Description
; 1 IEN of DIALOG file
;
; 1 2 3 4 5 6
; Returned: Ok?^status^histien^actdt^inactdt^sctm
N SCTM,SC,SCFLD,SCACTM
N SCPTAIEN,SCESEQ,SCPARM,SCIEN
S SCACTM=-1
;does entry exist? if not create
G:'$$OKNMDATA QTNM ;check/setup variables
S SCTM=$O(^SCTM(404.51,"B",SCTMNM,""))
IF 'SCTM D
.S SC($J,404.51,"+1,",.01)=SCTMNM
.IF $D(SCMAINA) D
..S SCFLD=0
..F S SCFLD=$O(@SCMAINA@(SCFLD)) Q:'SCFLD D
...S SC($J,404.51,"+1,",SCFLD)=@SCMAINA@(SCFLD)
.D UPDATE^DIE("","SC($J)","SCIEN","SCERR")
.I $D(@SCERR) K SCIEN
.S SCTM=$G(SCIEN(1))
S SCACTM=$$ACTM(SCTM,SCFIELDA,SCEFF,SCERR)
QTNM Q SCACTM_U_SCTM
;
ACTM(SCTM,SCFIELDA,SCEFF,SCERR) ; activate team from internal entry#
; input:
; SCTM = Pointer to Team File (#404.51)
; SCFIELDA= array of extra field entries for history entries (404.58)
; SCEFF = date to activate [default=DT]
; SCERR = array NAME to store error messages.
; [ex. ^TMP("ORXX",$J)]
;
; Output:
; SCPTAIEN = ien if entry made to file 404.43, 0 ow
; SCERR() = Array of DIALOG file messages(errors) .
; Foramt:
; Subscript: Sequential # from 1 to n
; Piece Description
; 1 IEN of DIALOG file
; 1 2 3 4
; Returned: status^history ien^actdt^inactdt
;
N SCTMDTS,SCXX,SCOK,SCHIST,SCACTM,SCSTATUS
N SCPTAIEN,SCESEQ,SCPARM,SCIEN
G:'$$OKDATA() QT
S SCSTATUS=$G(@SCFIELDA@(.03))
S SCTMDTS("BEGIN")=SCEFF
S SCTMDTS("END")=3990101
;for inactive check for any activity in future
;for active check for continuous activity in future
S SCTMDTS("INCL")='SCSTATUS
S SCOK=0
IF "^1^0^"'[(U_SCSTATUS_U) D G QT
.S SCOK=-1
.S SCPARM("TEAM")=$G(SCTM,"Undefined")
.S SCPARM("MESSAGE")="Required Field: #.03"_SCSTATUS
.D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
;is team already active or will be in future?
S SCHIST=$P($$ACTHIST^SCAPMCU2(404.58,SCTM,"SCTMDTS",.SCERR,"SCXX"),U,1,4)
IF ('SCSTATUS)&($P(SCHIST,U,3)'<SCEFF) D G QT
. S SCPARM("TEAM")=$G(SCTM,"Undefined")
. S SCPARM("MESSAGE")="Inactivation Date must not be equal to Inactivation Date"
. D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
IF (+SCHIST+SCSTATUS)=1!('$D(^SCTM(404.58,"B",SCTM))) D ;procede if not at state now
.S SC($J,404.58,"+1,",.01)=SCTM
.S SC($J,404.58,"+1,",.02)=SCEFF
.IF $D(SCFIELDA) D
..S SCFLD=0
..F S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD D
...S SC($J,404.58,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
.D UPDATE^DIE("","SC($J)","SCIEN","SCERR")
.IF '$G(@SCERR@(0))<1 D
.S:SCSTATUS SCHIST=SCSTATUS_U_SCIEN(1)_U_SCEFF_U
.S:'SCSTATUS SCHIST=SCSTATUS_U_SCIEN(1)_U_$P(SCHIST,U,3)_U_SCEFF
.S SCOK=1
QT Q SCOK_U_$G(SCHIST)
;
OKDATA() ;
;setup/check variables for actm call
N SCOK,SCFLD
S SCOK=1
D INIT^SCAPMCU1(.SCOK)
S:'$G(SCEFF) SCEFF=DT
F SCFLD=.03,.04 IF '($D(@SCFIELDA@(SCFLD))#2) D
. S SCPARM("TEAM")=$G(SCTM,"Undefined")
. D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
Q SCOK
OKNMDATA() ;
;setup/check variables for actmnm call
N SCOK,SCFLD
S SCOK=1
D INIT^SCAPMCU1(.SCOK)
S:'$G(SCEFF) SCEFF=DT
; only check 404.51 fields if no entry already
IF '$D(^SCTM(404.51,"B",SCTMNM)) D
.F SCFLD=.03,.06,.07 IF '($D(@SCMAINA@(SCFLD))#2) D
..S SCPARM("TEAM")=$G(SCTM,"Undefined")
..S SCPARM("MESSAGE")="Required Field: #"_SCFLD
..D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
F SCFLD=.03,.04 IF '($D(@SCFIELDA@(SCFLD))#2) D
. S SCPARM("TEAM")=$G(SCTM,"Undefined")
. D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
Q SCOK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCAPMC15 4475 printed Dec 13, 2024@02:37:49 Page 2
SCAPMC15 ;ALB/REW - Team API's ; December 1, 1995
+1 ;;5.3;Scheduling;**41**;AUG 13, 1993
+2 ;;1.0
ACTMNM(SCTMNM,SCFIELDA,SCMAINA,SCEFF,SCERR) ; -- activate a team (add if need be)
+1 ; input:
+2 ; SCTMNM = External Value of Team Name
+3 ; SCFIELDA= similar to above -used for history entries (404.58)
+4 ; SCMAINA = array of extra field entries - scfielda('fld#')=value
+5 ; -Note: Only used if BRAND NEW TEAM - team fields (404.51)
+6 ; SCEFF = date to activate [default=DT]
+7 ; SCERR = array NAME to store error messages.
+8 ; [ex. ^TMP("ORXX",$J)]
+9 ;
+10 ; Output:
+11 ; SCPTAIEN = ien if entry made to file 404.43, 0 ow
+12 ; SCERR() = Array of DIALOG file messages(errors) .
+13 ; Foramt:
+14 ; Subscript: Sequential # from 1 to n
+15 ; Piece Description
+16 ; 1 IEN of DIALOG file
+17 ;
+18 ; 1 2 3 4 5 6
+19 ; Returned: Ok?^status^histien^actdt^inactdt^sctm
+20 NEW SCTM,SC,SCFLD,SCACTM
+21 NEW SCPTAIEN,SCESEQ,SCPARM,SCIEN
+22 SET SCACTM=-1
+23 ;does entry exist? if not create
+24 ;check/setup variables
if '$$OKNMDATA
GOTO QTNM
+25 SET SCTM=$ORDER(^SCTM(404.51,"B",SCTMNM,""))
+26 IF 'SCTM
Begin DoDot:1
+27 SET SC($JOB,404.51,"+1,",.01)=SCTMNM
+28 IF $DATA(SCMAINA)
Begin DoDot:2
+29 SET SCFLD=0
+30 FOR
SET SCFLD=$ORDER(@SCMAINA@(SCFLD))
if 'SCFLD
QUIT
Begin DoDot:3
+31 SET SC($JOB,404.51,"+1,",SCFLD)=@SCMAINA@(SCFLD)
End DoDot:3
End DoDot:2
+32 DO UPDATE^DIE("","SC($J)","SCIEN","SCERR")
+33 IF $DATA(@SCERR)
KILL SCIEN
+34 SET SCTM=$GET(SCIEN(1))
End DoDot:1
+35 SET SCACTM=$$ACTM(SCTM,SCFIELDA,SCEFF,SCERR)
QTNM QUIT SCACTM_U_SCTM
+1 ;
ACTM(SCTM,SCFIELDA,SCEFF,SCERR) ; activate team from internal entry#
+1 ; input:
+2 ; SCTM = Pointer to Team File (#404.51)
+3 ; SCFIELDA= array of extra field entries for history entries (404.58)
+4 ; SCEFF = date to activate [default=DT]
+5 ; SCERR = array NAME to store error messages.
+6 ; [ex. ^TMP("ORXX",$J)]
+7 ;
+8 ; Output:
+9 ; SCPTAIEN = ien if entry made to file 404.43, 0 ow
+10 ; SCERR() = Array of DIALOG file messages(errors) .
+11 ; Foramt:
+12 ; Subscript: Sequential # from 1 to n
+13 ; Piece Description
+14 ; 1 IEN of DIALOG file
+15 ; 1 2 3 4
+16 ; Returned: status^history ien^actdt^inactdt
+17 ;
+18 NEW SCTMDTS,SCXX,SCOK,SCHIST,SCACTM,SCSTATUS
+19 NEW SCPTAIEN,SCESEQ,SCPARM,SCIEN
+20 if '$$OKDATA()
GOTO QT
+21 SET SCSTATUS=$GET(@SCFIELDA@(.03))
+22 SET SCTMDTS("BEGIN")=SCEFF
+23 SET SCTMDTS("END")=3990101
+24 ;for inactive check for any activity in future
+25 ;for active check for continuous activity in future
+26 SET SCTMDTS("INCL")='SCSTATUS
+27 SET SCOK=0
+28 IF "^1^0^"'[(U_SCSTATUS_U)
Begin DoDot:1
+29 SET SCOK=-1
+30 SET SCPARM("TEAM")=$GET(SCTM,"Undefined")
+31 SET SCPARM("MESSAGE")="Required Field: #.03"_SCSTATUS
+32 DO ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
End DoDot:1
GOTO QT
+33 ;is team already active or will be in future?
+34 SET SCHIST=$PIECE($$ACTHIST^SCAPMCU2(404.58,SCTM,"SCTMDTS",.SCERR,"SCXX"),U,1,4)
+35 IF ('SCSTATUS)&($PIECE(SCHIST,U,3)'<SCEFF)
Begin DoDot:1
+36 SET SCPARM("TEAM")=$GET(SCTM,"Undefined")
+37 SET SCPARM("MESSAGE")="Inactivation Date must not be equal to Inactivation Date"
+38 DO ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
End DoDot:1
GOTO QT
+39 ;procede if not at state now
IF (+SCHIST+SCSTATUS)=1!('$DATA(^SCTM(404.58,"B",SCTM)))
Begin DoDot:1
+40 SET SC($JOB,404.58,"+1,",.01)=SCTM
+41 SET SC($JOB,404.58,"+1,",.02)=SCEFF
+42 IF $DATA(SCFIELDA)
Begin DoDot:2
+43 SET SCFLD=0
+44 FOR
SET SCFLD=$ORDER(@SCFIELDA@(SCFLD))
if 'SCFLD
QUIT
Begin DoDot:3
+45 SET SC($JOB,404.58,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
End DoDot:3
End DoDot:2
+46 DO UPDATE^DIE("","SC($J)","SCIEN","SCERR")
+47 IF '$GET(@SCERR@(0))<1
Begin DoDot:2
End DoDot:2
+48 if SCSTATUS
SET SCHIST=SCSTATUS_U_SCIEN(1)_U_SCEFF_U
+49 if 'SCSTATUS
SET SCHIST=SCSTATUS_U_SCIEN(1)_U_$PIECE(SCHIST,U,3)_U_SCEFF
+50 SET SCOK=1
End DoDot:1
QT QUIT SCOK_U_$GET(SCHIST)
+1 ;
OKDATA() ;
+1 ;setup/check variables for actm call
+2 NEW SCOK,SCFLD
+3 SET SCOK=1
+4 DO INIT^SCAPMCU1(.SCOK)
+5 if '$GET(SCEFF)
SET SCEFF=DT
+6 FOR SCFLD=.03,.04
IF '($DATA(@SCFIELDA@(SCFLD))#2)
Begin DoDot:1
+7 SET SCPARM("TEAM")=$GET(SCTM,"Undefined")
+8 DO ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
End DoDot:1
+9 QUIT SCOK
OKNMDATA() ;
+1 ;setup/check variables for actmnm call
+2 NEW SCOK,SCFLD
+3 SET SCOK=1
+4 DO INIT^SCAPMCU1(.SCOK)
+5 if '$GET(SCEFF)
SET SCEFF=DT
+6 ; only check 404.51 fields if no entry already
+7 IF '$DATA(^SCTM(404.51,"B",SCTMNM))
Begin DoDot:1
+8 FOR SCFLD=.03,.06,.07
IF '($DATA(@SCMAINA@(SCFLD))#2)
Begin DoDot:2
+9 SET SCPARM("TEAM")=$GET(SCTM,"Undefined")
+10 SET SCPARM("MESSAGE")="Required Field: #"_SCFLD
+11 DO ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
End DoDot:2
End DoDot:1
+12 FOR SCFLD=.03,.04
IF '($DATA(@SCFIELDA@(SCFLD))#2)
Begin DoDot:1
+13 SET SCPARM("TEAM")=$GET(SCTM,"Undefined")
+14 DO ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
End DoDot:1
+15 QUIT SCOK
