source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCAPMC7.m@ 767

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1SCAPMC7 ;ALB/REW - Team APIs:INPTTM ; 5 Jul 1995
2 ;;5.3;Scheduling;**41,148**;AUG 13, 1993
3 ;;1.0
4INPTTM(DFN,SCPTTM,SCINACT,SCERR) ;inactivate patient from a team (pt tm assgn - #404.42
5 ; input:
6 ; DFN = pointer to PATIENT file (#2)
7 ; SCPTTM = pointer to pt team assign file (#404.42)
8 ; SCINACT = date to inactivate [default=DT]
9 ; SCERR = array NAME to store error messages.
10 ; [ex. ^TMP("ORXX",$J)]
11 ;
12 ; Output:
13 ; SCOK = 1 if inactivation entry made to file 404.42, 0 ow
14 ; SCERR() = Array of DIALOG file messages(errors) .
15 ; Foramt:
16 ; @SCERR@(0)=Number of erros, undefined if none
17 ; Subscript: Sequential # from 1 to n
18 ; Piece Description
19 ; 1 IEN of DIALOG file
20 N SCTM,SC,SCPARM,SCESEQ,SCLSEQ,SCOK
21 S SCOK=0
22 G:'$$OKDATA APTTMQ ;setup/check variables
23 S SCTM=+$P($G(^SCPT(404.42,SCPTTM,0)),U,3)
24 IF '$$PTTMACT(DFN,SCTM,SCINACT,.SCERR) D G APTTMQ
25 .S SCOK=0
26 .S SCPARM("INACTIVE DATE")=SCINACT
27 .D ERR^SCAPMCU1(SCESEQ,4044201,.SCPARM,"",.SCERR)
28 ELSE D
29 .S SCOK=1
30 .S SC($J,404.42,SCPTTM_",",.09)=SCINACT
31 .S SC($J,404.42,SCPTTM_",",.13)=$G(DUZ,.5)
32 .D NOW^%DTC
33 .S SC($J,404.42,SCPTTM_",",.14)=%
34 .D UPDATE^DIE("","SC($J)","SCIEN",.SCERR)
35 .I $D(@SCERR@("DIERR")) S SCOK=0
36APTTMQ Q SCOK
37 ;
38PTTMACT(DFN,SCTM,SCDT,SCERR) ;is patient assigned to a team on a given date-time?
39 N SCTMDTS,SCTMLST,SCOK
40 S SCOK=0
41 S (SCTMDTS("BEGIN"),SCTMDTS("END"))=SCDT
42 IF $$TMPT^SCAPMC3(DFN,"SCTMDTS","","SCTMLST",.SCERR) S:$D(SCTMLST("SCTM",SCTM)) SCOK=1
43 Q SCOK
44OKDATA() ;check/setup variables - return 1 if ok/0 if error
45 N SCOK
46 S SCOK=1
47 D INIT^SCAPMCU1(.SCOK)
48 IF '$D(^DPT(DFN,0))!('$D(^SCPT(404.42,SCPTTM,0))) D S SCOK=0
49 . S SCPARM("PATIENT")=$G(DFN,"Undefined")
50 . S SCPARM("Pt TEAM Asnt")=$G(SCPTTM,"Undefined")
51 . D ERR^SCAPMCU1(SCESEQ,4045101,.SCPARM,"",.SCERR)
52 S:'$G(SCACT) SCACT=DT
53 S:'$G(SCINACT) SCINACT=DT
54 Q SCOK
55 ;
56INPTATM(DFNA,SCTM,SCFIELDA,SCACT,SCERR,SCNEWTM,SCOLDTM,SCBADTM) ;list of patients assigned to a team (404.42)
57 ; input: as per ACPTTM (above with the following change:)
58 ; DFNA = is the literal value of a patient array (e.g. "scpt"
59 ; there is at least one scpt(dfn)="" defined
60 ; SCNEWTM = Subset of DFNA that was NEWLY assigned to Team [returned]
61 ; SCOLDTM = Subset of DFNA that was already assigned -Team [returned]
62 ; SCBADTP = Subset of DFNA that was NOT assigned to Team [returned]
63 ; Note: The above three arrays return data in a user determined array
64 ; output: Count of Patients:
65 ; 1 2 3 4
66 ; total assigned^newly assigned^assigned prior^not assigned
67 N DFN,SCNEWCNT,SCOLDCNT,SCBADCNT,SCX
68 S (SCNEWCNT,SCOLDCNT,SCBADCNT)=0
69 S DFN=0 F S DFN=$O(@DFNA@(DFN)) Q:'DFN D
70 .S SCPTTM=$$HISTPTTM^SCAPMCU2(DFN,.SCTM,.SCACT)
71 .S SCX=$S(SCPTTM:$$INPTTM(.DFN,.SCPTTM,.SCFIELDA,.SCACT,.SCERR),1:0)
72 .; SCX = ien of 404.42^new?
73 .IF $P(SCX,U,2) D ;newly assigned
74 ..S SCNEWCNT=SCNEWCNT+1
75 ..S @SCNEWTM@(DFN)=+SCX ;scnewtm
76 .IF $P(SCX,U,1)&('$P($G(SCX),U,2)) D ;old
77 ..S SCOLDCNT=SCOLDCNT+1
78 ..S @SCOLDTM@(DFN)=+SCX
79 .IF 'SCX D
80 ..S @SCBADTM@(DFN)=""
81 ..S SCBADCNT=SCBADCNT+1
82 Q (SCNEWCNT+SCOLDCNT)_U_SCNEWCNT_U_SCOLDCNT_U_SCBADCNT
83 ;
84INPTSCTM(DFN,SCTM,SCINACT,SCERR) ;inactivate patient from a team - using last pt team assignment - Note: This uses pointer to 404.51 (team) not 404.42 as input
85 ; input:
86 ; DFN = pointer to PATIENT file (#2)
87 ; SCTM = pointer to TEAM file (#404.51)
88 ; SCINACT = date to inactivate [default=DT]
89 ; SCERR = array NAME to store error messages.
90 ; [ex. ^TMP("ORXX",$J)]
91 ;
92 ; Output:
93 ; SCOK = 1 if inactivation entry made to file 404.42, 0 ow
94 ; SCERR() = Array of DIALOG file messages(errors) .
95 ; Foramt:
96 ; @SCERR@(0)=Number of erros, undefined if none
97 ; Subscript: Sequential # from 1 to n
98 ; Piece Description
99 ; 1 IEN of DIALOG file
100 ;
101 N SCACT
102 S SCACT=+$O(^SCPT(404.42,"AIDT",DFN,SCTM,""))
103 S SCPTTM=+$O(^SCPT(404.42,"AIDT",DFN,SCTM,SCACT,0))
104 Q $$INPTTM(.DFN,.SCPTTM,.SCINACT,.SCERR)
Note: See TracBrowser for help on using the repository browser.