1 | SCAPMC15 ;ALB/REW - Team API's ; December 1, 1995
|
---|
2 | ;;5.3;Scheduling;**41**;AUG 13, 1993
|
---|
3 | ;;1.0
|
---|
4 | ACTMNM(SCTMNM,SCFIELDA,SCMAINA,SCEFF,SCERR) ; -- activate a team (add if need be)
|
---|
5 | ; input:
|
---|
6 | ; SCTMNM = External Value of Team Name
|
---|
7 | ; SCFIELDA= similar to above -used for history entries (404.58)
|
---|
8 | ; SCMAINA = array of extra field entries - scfielda('fld#')=value
|
---|
9 | ; -Note: Only used if BRAND NEW TEAM - team fields (404.51)
|
---|
10 | ; SCEFF = date to activate [default=DT]
|
---|
11 | ; SCERR = array NAME to store error messages.
|
---|
12 | ; [ex. ^TMP("ORXX",$J)]
|
---|
13 | ;
|
---|
14 | ; Output:
|
---|
15 | ; SCPTAIEN = ien if entry made to file 404.43, 0 ow
|
---|
16 | ; SCERR() = Array of DIALOG file messages(errors) .
|
---|
17 | ; Foramt:
|
---|
18 | ; Subscript: Sequential # from 1 to n
|
---|
19 | ; Piece Description
|
---|
20 | ; 1 IEN of DIALOG file
|
---|
21 | ;
|
---|
22 | ; 1 2 3 4 5 6
|
---|
23 | ; Returned: Ok?^status^histien^actdt^inactdt^sctm
|
---|
24 | N SCTM,SC,SCFLD,SCACTM
|
---|
25 | N SCPTAIEN,SCESEQ,SCPARM,SCIEN
|
---|
26 | S SCACTM=-1
|
---|
27 | ;does entry exist? if not create
|
---|
28 | G:'$$OKNMDATA QTNM ;check/setup variables
|
---|
29 | S SCTM=$O(^SCTM(404.51,"B",SCTMNM,""))
|
---|
30 | IF 'SCTM D
|
---|
31 | .S SC($J,404.51,"+1,",.01)=SCTMNM
|
---|
32 | .IF $D(SCMAINA) D
|
---|
33 | ..S SCFLD=0
|
---|
34 | ..F S SCFLD=$O(@SCMAINA@(SCFLD)) Q:'SCFLD D
|
---|
35 | ...S SC($J,404.51,"+1,",SCFLD)=@SCMAINA@(SCFLD)
|
---|
36 | .D UPDATE^DIE("","SC($J)","SCIEN","SCERR")
|
---|
37 | .I $D(@SCERR) K SCIEN
|
---|
38 | .S SCTM=$G(SCIEN(1))
|
---|
39 | S SCACTM=$$ACTM(SCTM,SCFIELDA,SCEFF,SCERR)
|
---|
40 | QTNM Q SCACTM_U_SCTM
|
---|
41 | ;
|
---|
42 | ACTM(SCTM,SCFIELDA,SCEFF,SCERR) ; activate team from internal entry#
|
---|
43 | ; input:
|
---|
44 | ; SCTM = Pointer to Team File (#404.51)
|
---|
45 | ; SCFIELDA= array of extra field entries for history entries (404.58)
|
---|
46 | ; SCEFF = date to activate [default=DT]
|
---|
47 | ; SCERR = array NAME to store error messages.
|
---|
48 | ; [ex. ^TMP("ORXX",$J)]
|
---|
49 | ;
|
---|
50 | ; Output:
|
---|
51 | ; SCPTAIEN = ien if entry made to file 404.43, 0 ow
|
---|
52 | ; SCERR() = Array of DIALOG file messages(errors) .
|
---|
53 | ; Foramt:
|
---|
54 | ; Subscript: Sequential # from 1 to n
|
---|
55 | ; Piece Description
|
---|
56 | ; 1 IEN of DIALOG file
|
---|
57 | ; 1 2 3 4
|
---|
58 | ; Returned: status^history ien^actdt^inactdt
|
---|
59 | ;
|
---|
60 | N SCTMDTS,SCXX,SCOK,SCHIST,SCACTM,SCSTATUS
|
---|
61 | N SCPTAIEN,SCESEQ,SCPARM,SCIEN
|
---|
62 | G:'$$OKDATA() QT
|
---|
63 | S SCSTATUS=$G(@SCFIELDA@(.03))
|
---|
64 | S SCTMDTS("BEGIN")=SCEFF
|
---|
65 | S SCTMDTS("END")=3990101
|
---|
66 | ;for inactive check for any activity in future
|
---|
67 | ;for active check for continuous activity in future
|
---|
68 | S SCTMDTS("INCL")='SCSTATUS
|
---|
69 | S SCOK=0
|
---|
70 | IF "^1^0^"'[(U_SCSTATUS_U) D G QT
|
---|
71 | .S SCOK=-1
|
---|
72 | .S SCPARM("TEAM")=$G(SCTM,"Undefined")
|
---|
73 | .S SCPARM("MESSAGE")="Required Field: #.03"_SCSTATUS
|
---|
74 | .D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
|
---|
75 | ;is team already active or will be in future?
|
---|
76 | S SCHIST=$P($$ACTHIST^SCAPMCU2(404.58,SCTM,"SCTMDTS",.SCERR,"SCXX"),U,1,4)
|
---|
77 | IF ('SCSTATUS)&($P(SCHIST,U,3)'<SCEFF) D G QT
|
---|
78 | . S SCPARM("TEAM")=$G(SCTM,"Undefined")
|
---|
79 | . S SCPARM("MESSAGE")="Inactivation Date must not be equal to Inactivation Date"
|
---|
80 | . D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
|
---|
81 | IF (+SCHIST+SCSTATUS)=1!('$D(^SCTM(404.58,"B",SCTM))) D ;procede if not at state now
|
---|
82 | .S SC($J,404.58,"+1,",.01)=SCTM
|
---|
83 | .S SC($J,404.58,"+1,",.02)=SCEFF
|
---|
84 | .IF $D(SCFIELDA) D
|
---|
85 | ..S SCFLD=0
|
---|
86 | ..F S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD D
|
---|
87 | ...S SC($J,404.58,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
|
---|
88 | .D UPDATE^DIE("","SC($J)","SCIEN","SCERR")
|
---|
89 | .IF '$G(@SCERR@(0))<1 D
|
---|
90 | .S:SCSTATUS SCHIST=SCSTATUS_U_SCIEN(1)_U_SCEFF_U
|
---|
91 | .S:'SCSTATUS SCHIST=SCSTATUS_U_SCIEN(1)_U_$P(SCHIST,U,3)_U_SCEFF
|
---|
92 | .S SCOK=1
|
---|
93 | QT Q SCOK_U_$G(SCHIST)
|
---|
94 | ;
|
---|
95 | OKDATA() ;
|
---|
96 | ;setup/check variables for actm call
|
---|
97 | N SCOK,SCFLD
|
---|
98 | S SCOK=1
|
---|
99 | D INIT^SCAPMCU1(.SCOK)
|
---|
100 | S:'$G(SCEFF) SCEFF=DT
|
---|
101 | F SCFLD=.03,.04 IF '($D(@SCFIELDA@(SCFLD))#2) D
|
---|
102 | . S SCPARM("TEAM")=$G(SCTM,"Undefined")
|
---|
103 | . D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
|
---|
104 | Q SCOK
|
---|
105 | OKNMDATA() ;
|
---|
106 | ;setup/check variables for actmnm call
|
---|
107 | N SCOK,SCFLD
|
---|
108 | S SCOK=1
|
---|
109 | D INIT^SCAPMCU1(.SCOK)
|
---|
110 | S:'$G(SCEFF) SCEFF=DT
|
---|
111 | ; only check 404.51 fields if no entry already
|
---|
112 | IF '$D(^SCTM(404.51,"B",SCTMNM)) D
|
---|
113 | .F SCFLD=.03,.06,.07 IF '($D(@SCMAINA@(SCFLD))#2) D
|
---|
114 | ..S SCPARM("TEAM")=$G(SCTM,"Undefined")
|
---|
115 | ..S SCPARM("MESSAGE")="Required Field: #"_SCFLD
|
---|
116 | ..D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
|
---|
117 | F SCFLD=.03,.04 IF '($D(@SCFIELDA@(SCFLD))#2) D
|
---|
118 | . S SCPARM("TEAM")=$G(SCTM,"Undefined")
|
---|
119 | . D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
|
---|
120 | Q SCOK
|
---|