source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCAPMC26.m@ 719

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1SCAPMC26 ;ALB/REW - API: Patients in a Clinic ; December 1, 1995 [12/21/98 4:30pm]
2 ;;5.3;Scheduling;**41,157**;AUG 13, 1993
3 ;
4PTCL(SC44,SCDATES,SCLIST,SCERR) ; patients in a clinic
5 ; Input:
6 ; SC44 - Pointer to Hospital Location File #44
7 ; SCDATES- Date array (begin, end, incl)
8 ; SCLIST - Name of output array
9 ; SCERR = array NAME to store error messages.
10 ; [ex. ^TMP("ORXX",$J
11 ; Output:
12 ; SCLIST() = array of practitioners (users) - pointers to file #200
13 ; Format:
14 ; Subscript: Sequential # from 1 to n
15 ; Piece Description
16 ; 1 DFN - Ptr to Patient File (#2)
17 ; 2 Patient Name (External)
18 ; 3 null
19 ; 4 Activation Date
20 ; 5 Discharge Date
21 ; 6 '1' - for merge reasons with other pt lists
22 ; 7 sc44
23 ;
24 ; SCERR() = Array of DIALOG file messages(errors) .
25 ; @SCERR(0)= Number of error(s), UNDEFINED if no errors
26 ; Foramt:
27 ; Subscript: Sequential # from 1 to n
28 ; Piece Description
29 ; 1 IEN of DIALOG file
30 ; Returned: 1 if ok, 0 if error
31 ;
32ST N DFN,SCOK,SCCL,SCCLDT
33 N SCLSEQ,SCN,SCESEQ,SCPARM,SCBEGIN,SCEND,SCINCL,SCDTS
34 ; -- initialize control variables
35 S SCOK=1
36 G:'$$OKDATA CLTPQ
37 ;S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN IF $D(^DPT(DFN,"DE","B",SC44)) S SCCL=$O(^DPT(DFN,"DE","B",SC44,0)) D
38 S SCCLDT=0
39 F S SCCLDT=$O(^DPT("AEB1",SC44,SCCLDT)) Q:'SCCLDT D
40 .S DFN=0
41 .F S DFN=$O(^DPT("AEB1",SC44,SCCLDT,DFN)) Q:'DFN D
42 ..Q:$D(^TMP("SCMC",$J,"EXCLUDE PT","SCPTA",DFN))
43 ..;;bp/cmf 2981008
44 ..;;modified code begin
45 ..S SCCL=$O(^DPT("AEB1",SC44,SCCLDT,DFN,0))
46 ..Q:'SCCL
47 ..S SCX=$O(^DPT("AEB1",SC44,SCCLDT,DFN,SCCL,0))
48 ..Q:'SCX
49 ..S SCNODE=$G(^DPT(DFN,"DE",SCCL,1,SCX,0))
50 ..I $$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,$P($P(SCNODE,U,1),"."),$P(SCNODE,U,3)) D
51 ...S SCN=$G(@SCLIST@(0),0)+1
52 ...S @SCLIST@(0)=SCN
53 ...S @SCLIST@(SCN)=DFN_U_$P($G(^DPT(DFN,0)),U,1)_U_U_$P(SCNODE,U,1)_U_$P(SCNODE,U,3)_U_"1"_U_SC44_U_$P($G(^DPT(DFN,.36)),U,3)
54 ...Q
55 ..S @SCLIST@("SC PTCL",DFN,SCX,SCN)=""
56 ..Q
57 .Q
58 ;;..modified code end
59 ;;..original code begin
60 ;;..Q:$D(@SCLIST@("SC PTCL",DFN))
61 ;;..S SCCL=0
62 ;;..F S SCCL=$O(^DPT(DFN,"DE","B",SC44,SCCL)) Q:'SCCL D
63 ;;...S SCX=0 F S SCX=$O(^DPT(DFN,"DE",SCCL,1,SCX)) Q:'SCX S SCNODE=^(SCX,0) D
64 ;;....IF $$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,$P(SCNODE,U,1),$P(SCNODE,U,3)) D
65 ;;.....Q:$D(@SCLIST@("SC PTCL",DFN))
66 ;;.....S SCN=$G(@SCLIST@(0),0)+1
67 ;;.....S @SCLIST@(0)=SCN
68 ;;.....S @SCLIST@(SCN)=DFN_U_$P($G(^DPT(DFN,0)),U,1)_U_U_$P(SCNODE,U,1)_U_$P(SCNODE,U,3)_U_"1"_U_SC44_U_$P($G(^DPT(DFN,.36)),U,3)
69 ;;....S @SCLIST@("SC PTCL",DFN,SCX,SCN)=""
70 ;;original code end
71 ;;bp/cmf 2981008
72CLTPQ Q $G(@SCERR@(0))<1
73 ;
74OKDATA() ;check/setup variables - return 1 if ok; 0 if error
75 N SCOK
76 S SCOK=1
77 S (SCN,SCESEQ,SCLSEQ)=0
78 D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)
79 IF '$D(^SC(+$G(SC44),0)) D S SCOK=0
80 . S SCPARM("CLINIC")=$G(SC44,"Undefined")
81 . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
82 IF '$L($G(SCLIST)) D S SCOK=0
83 . S SCPARM("OUTPUT ARRAY")=$G(SCLIST,"Undefined")
84 . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
85 Q SCOK
86 ;
87PTCLBR(SC44,SCTM,SCDATES) ;for PCMM use only!! returns list to ^tmp($j,'scclpt'
88 ; SC44 - Clinic we're adding to team
89 ; SCTM - EXCLUDES Patients assigned to SCTM Team during time period
90 ; SCDATES - Standard Date array
91 ; Returns: $j if successful & at least one entry, 0 if error or none
92 ; Warning: Kills ^tmp($j,'scclpt') before it runs & ^tmp('scmc',$j,'exclude pt') after it runs
93 N SCCLERR,SCX,SCXX
94 K ^TMP($J,"SCCLPT")
95 S SCXX=$$PTTM^SCAPMC(SCTM,.SCDATES,"^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCCLERR")
96 S SCX=$$PTCL(.SC44,.SCDATES,"^TMP($J,""SCCLPT"")","SCCLERR")
97 K ^TMP("SCMC",$J,"EXCLUDE PT")
98 Q $S('SCX:0,('$G(^TMP($J,"SCCLPT",0))):0,1:$J)
99 ;
100PTCLBRTP(SC44,SCTP,SCDATES) ;for PCMM use only!! returns list to ^tmp($j,'scclpt'
101 ; SC44 - Clinic we're adding to team
102 ; SCTP - EXCLUDES Patients assigned to SCTP Position during scdates
103 ; SCDATES - Standard Date array
104 ; Returns: $j if successful & at least one entry, 0 if error or none
105 ; Warning: Kills ^tmp($j,'scclpt') before it runs
106 N SCCLERR,SCX,SCXX
107 K ^TMP($J,"SCCLPT")
108 S SCXX=$$PTTP^SCAPMC(SCTP,.SCDATES,"^TMP(""SCMC"",$J,""EXCLUDE PT"")","SCCLERR")
109 S SCX=$$PTCL(.SC44,.SCDATES,"^TMP($J,""SCCLPT"")","SCCLERR")
110 K ^TMP("SCMC",$J,"EXCLUDE PT")
111 Q $S('SCX:0,('$G(^TMP($J,"SCCLPT",0))):0,1:$J)
112 ;
Note: See TracBrowser for help on using the repository browser.