source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCAPMC19.m@ 846

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

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1SCAPMC19 ;ALB/REW - Team API's ; 12 Jan 99 9:10 AM
2 ;;5.3;Scheduling;**41,174**;AUG 13, 1993
3 ;;1.0
4ACPRTP(SC200,SCTP,SCFIELDA,SCEFF,SCERR) ; assign practitioner to position
5 ; input:
6 ; SC200 = New Person File (#200) Pointer
7 ; SCTP = Pointer To Team Position File (#404.57)
8 ; SCFIELDA= array of extra field entries - scfielda('fld#')=value
9 ; -Note: Only used if BRAND NEW POSITION - team fields (404.57)
10 ; SCEFF = date to activate/inactivate [default=DT]
11 ; SCERR = array NAME to store error messages.
12 ; [ex. ^TMP("ORXX",$J)]
13 ;
14 ; Output:
15 ; SCERR() = Array of DIALOG file messages(errors) .
16 ; Foramt:
17 ; Subscript: Sequential # from 1 to n
18 ; Piece Description
19 ; 1 IEN of DIALOG file
20 ;
21 ; 1 2 3 4 5
22 ; Returned: status^histien^actdt^inactdt^sctm
23 ;
24 ;
25 N SCTPDTS,SCXX,SCOK,SCHIST,SCACTP,SCSTATUS
26 N SCPTAIEN,SCESEQ,SCPARM,SCIEN
27 G:'$$OKDATA() QT
28 S SCSTATUS=$G(@SCFIELDA@(.04))
29 S SCTPDTS("BEGIN")=SCEFF
30 S SCTPDTS("END")=3990101
31 ;for inactive check for any activity in future
32 ;for active check for continuous activity in future
33 S SCTPDTS("INCL")='SCSTATUS
34 S SCOK=0
35 IF "^1^0^"'[(U_SCSTATUS_U) D G QT
36 .S SCOK=-1
37 .S SCPARM("POSITION")=$G(SCTP,"Undefined")
38 .S SCPARM("PRACTITIONER")=$G(SC200,"Undefined")
39 .S SCPARM("MESSAGE")="Required Field: #.04 = "_SCSTATUS
40 .D ERR^SCAPMCU1(.SCESEQ,4045200,.SCPARM,"",.SCERR)
41 ;is position already active or will be in future?
42 S SCHIST=$P($$ACTHIST^SCAPMCU2(404.52,SCTP,"SCTPDTS",.SCERR,"SCXX"),U,1,4)
43 ;inactivation must be after activation date
44 IF ('SCSTATUS)&($P(SCHIST,U,3)'<SCEFF) D G QT
45 . S SCPARM("PRACTITIONER")=$G(SC200,"Undefined")
46 . S SCPARM("POSITION")=$G(SCTP,"Undefined")
47 . S SCPARM("MESSAGE")="Inactivation Date must not be equal to Inactivation Date"
48 . D ERR^SCAPMCU1(.SCESEQ,4045200,.SCPARM,"",.SCERR)
49 ;must inactivate same practitioner who was last activated
50 S SCOLD200=$P($G(^SCTM(404.52,+$P(SCHIST,U,2),0)),U,3)
51 IF ('SCSTATUS)&(SCOLD200&(SCOLD200'=SC200)) D G QT
52 . S SCOK=-1
53 . S SCPARM("PRACTITIONER")=$G(SC200,"Undefined")
54 . S SCPARM("MESSAGE")="Inactivation must be for same practitioner who was last activated"
55 . D ERR^SCAPMCU1(.SCESEQ,4045200,.SCPARM,"",.SCERR)
56 IF (+SCHIST+SCSTATUS)=1!('$D(^SCTM(404.52,"B",SCTP))) D ;procede if not at state now
57 .S SC($J,404.52,"+1,",.01)=SCTP
58 .S SC($J,404.52,"+1,",.02)=SCEFF
59 .S SC($J,404.52,"+1,",.03)=SC200
60 .IF $D(SCFIELDA) D
61 ..S SCFLD=0
62 ..F S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD D
63 ...S SC($J,404.52,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
64 .D UPDATE^DIE("","SC($J)","SCIEN",.SCERR)
65 .IF '$G(@SCERR@(0))<1 D
66 .S:SCSTATUS SCHIST=SCSTATUS_U_SCIEN(1)_U_SCEFF_U
67 .S:'SCSTATUS SCHIST=SCSTATUS_U_SCIEN(1)_U_$P(SCHIST,U,3)_U_SCEFF
68 .S SCOK=1
69QT Q SCOK_U_$G(SCHIST)
70 ;
71OKDATA() ;
72 ;setup/check variables for acTP call
73 N SCOK,SCFLD
74 S SCOK=1
75 D INIT^SCAPMCU1(.SCOK)
76 S:'$G(SCEFF) SCEFF=DT
77 IF '$D(^VA(200,+$G(SC200),0)) D
78 . S SCPARM("PRACTITIONER")=$G(SC200,"Undefined")
79 . D ERR^SCAPMCU1(.SCESEQ,4045201,.SCPARM,"",.SCERR)
80 IF '$D(^SCTM(404.57,+$G(SCTP),0)) D
81 . S SCPARM("POSITION")=$G(SCTP,"Undefined")
82 . D ERR^SCAPMCU1(.SCESEQ,4045701,.SCPARM,"",.SCERR)
83 F SCFLD=.04,.05 IF '($D(@SCFIELDA@(SCFLD))#2) D
84 . S SCPARM("PRACTITIONER")=$G(SC200,"Undefined")
85 . S SCPARM("MESSAGE")="Undefined history fields"
86 . D ERR^SCAPMCU1(.SCESEQ,4045200,.SCPARM,"",.SCERR)
87 Q SCOK
Note: See TracBrowser for help on using the repository browser.