source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCAPMC15.m@ 836

Last change on this file since 836 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1SCAPMC15 ;ALB/REW - Team API's ; December 1, 1995
2 ;;5.3;Scheduling;**41**;AUG 13, 1993
3 ;;1.0
4ACTMNM(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)
40QTNM Q SCACTM_U_SCTM
41 ;
42ACTM(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
93QT Q SCOK_U_$G(SCHIST)
94 ;
95OKDATA() ;
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
105OKNMDATA() ;
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
Note: See TracBrowser for help on using the repository browser.