source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCAPMC17.m@ 1801

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

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