source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCAPMC6.m@ 1147

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1SCAPMC6 ;ALB/REW - Team APIs:APPTTM ; 5 Jul 1995
2 ;;5.3;Scheduling;**41**;AUG 13, 1993
3 ;;1.0
4ACPTTM(DFN,SCTM,SCFIELDA,SCACT,SCERR) ;add a patient to a team (pt tm assgn - #404.42
5 ; input:
6 ; DFN = pointer to PATIENT file (#2)
7 ; SCTM = pointer to TEAM file (#404.51)
8 ; SCFIELDA= array of additional fields to be added
9 ; SCACT = date to activate [default=DT]
10 ; SCERR = array NAME to store error messages.
11 ; [ex. ^TMP("ORXX",$J)]
12 ;
13 ; Output:
14 ; Returned = ien of 404.42 - 0 if none after^new?^Message
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 N SCPTTM,SCESEQ,SCPARM,SCIEN,SC,SCFLD,SCNEWTM
21 G:'$$OKDATA APTTMQ ;check/setup variables
22 IF $S('$D(SCFIELDA):0,('($D(@SCFIELDA@(.08))#2)):0,($G(@SCFIELDA@(.08))=1):1,1:0) IF '$$OKPTTMPC^SCMCTMU2(DFN,SCTM,SCACT) D G APTTMQ
23 .S SCMESS=4044200.001
24 S SCPTTM=$$PTTMACT(DFN,SCTM,SCACT,.SCERR)
25 IF SCPTTM G APTTMQ
26 ELSE D
27 .IF $D(SCFIELDA) D
28 ..S SCFLD=0
29 ..F S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD D
30 ...S SC($J,404.42,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
31 .S SC($J,404.42,"+1,",.01)=DFN
32 .S SC($J,404.42,"+1,",.02)=SCACT
33 .S SC($J,404.42,"+1,",.03)=SCTM
34 .D UPDATE^DIE("","SC($J)","SCIEN","SCERR")
35 .IF $D(@SCERR) K SCIEN
36 .ELSE D
37 ..S SCPTTM=$G(SCIEN(1))
38 ..S SCNEWTM=1
39 ..D AFTERTM^SCMCDD1(SCPTTM)
40APTTMQ Q +$G(SCPTTM)_U_+$G(SCNEWTM)
41 ;
42PTTMACT(DFN,SCTM,SCDT,SCERR) ;what is patient/team assignment on a given date-time into the future? Return 404.42 ien or 0
43 N SCTMLST,SCOK,SCPTTMDT
44 S SCOK=0
45 S SCPTTMDT("BEGIN")=SCDT,SCPTTMDT("END")=3990101,SCPTTMDT("INCL")=0
46 IF $$TMPT^SCAPMC3(DFN,"SCPTTMDT","","SCTMLST",.SCERR) S:$D(SCTMLST("SCTM",SCTM)) SCOK=$O(SCTMLST("SCTM",SCTM,0))
47 Q SCOK
48 ;
49ACPTATM(DFNA,SCTM,SCFIELDA,SCACT,SCERR,SCNEWTM,SCOLDTM,SCBADTM) ;list of patients assigned to a team (404.42)
50 ; input: as per ACPTTM (above with the following change:)
51 ; DFNA = is the literal value of a patient array (e.g. "scpt"
52 ; there is at least one scpt(dfn)="" defined
53 ; SCNEWTM = Subset of DFNA that was NEWLY assigned to Team [returned]
54 ; SCOLDTM = Subset of DFNA that was already assigned -Team [returned]
55 ; SCBADTP = Subset of DFNA that was NOT assigned to Team [returned]
56 ; Note: The above three arrays return data in a user determined array
57 ; output: Count of Patients:
58 ; 1 2 3 4
59 ; total assigned^newly assigned^assigned prior^not assigned
60 N DFN,SCNEWCNT,SCOLDCNT,SCBADCNT,SCX,SCNOMAIL
61 S SCNOMAIL=1
62 S (SCNEWCNT,SCOLDCNT,SCBADCNT)=0
63 S DFN=0 F S DFN=$O(@DFNA@(DFN)) Q:'DFN D
64 .S SCX=$$ACPTTM(.DFN,.SCTM,.SCFIELDA,.SCACT,.SCERR)
65 .; SCX = ien of 404.42^new?
66 .IF $P(SCX,U,2) D ;newly assigned
67 ..S SCNEWCNT=SCNEWCNT+1
68 ..S @SCNEWTM@(DFN)=+SCX ;scnewtm
69 .IF $P(SCX,U,1)&('$P(SCX,U,2)) D ;old
70 ..S SCOLDCNT=SCOLDCNT+1
71 ..S @SCOLDTM@(DFN)=+SCX
72 .IF 'SCX D
73 ..S @SCBADTM@(DFN)=$P(SCX,U,3)
74 ..S SCBADCNT=SCBADCNT+1
75 K SCNOMAIL
76 D MAILLST^SCMCTMM(SCTM,.SCADDFLD,DT,.SCNEWTM,.SCOLDTM,.SCBADTM)
77 Q (SCNEWCNT+SCOLDCNT)_U_SCNEWCNT_U_SCOLDCNT_U_SCBADCNT
78 ;
79OKDATA() ;setup/check variables
80 N SCOK
81 S SCOK=1
82 D INIT^SCAPMCU1(.SCOK)
83 IF '$D(^DPT(DFN,0))!('$D(^SCTM(404.51,SCTM,0))) D S SCOK=0
84 . S SCPARM("PATIENT")=DFN
85 . S SCPARM("TEAM")=SCTM
86 . D ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
87 S:'$G(SCACT) SCACT=DT
88 Q SCOK
Note: See TracBrowser for help on using the repository browser.