1 | SCRPTP3 ;ALB/CMM - List of Team's Patients ; 29 Jun 99 04:11PM
|
---|
2 | ;;5.3;Scheduling;**41,48,98,177,231,433,526,520**;AUG 13, 1993;Build 26
|
---|
3 | ;;DMR BP-OIFO Patch SD*5.3*526
|
---|
4 | ;
|
---|
5 | ;List of Team's Patients Report
|
---|
6 | ;
|
---|
7 | HITS(ARRY,TIEN) ;
|
---|
8 | ;ARRY - list of patients for a given team
|
---|
9 | ;TIEN - team ien
|
---|
10 | ;
|
---|
11 | N PTIEN,PIEN,PTNAME,PNAME,PTAI,NXT,NODE,CIEN,CNAME,INAME,INST,LAST,NEXT
|
---|
12 | N PAIEN,PC,PHONE,PNODE,PTPA,PTPAN,ROL,PID,TINFO,TNAME,TPIEN,TPNODE
|
---|
13 | N CNT,TPA,FLAG,DFN,VA,VAERR,PCAP,ROLN
|
---|
14 | S INACTIVE=0
|
---|
15 | S NXT=0
|
---|
16 | F S NXT=$O(@ARRY@(NXT)) Q:NXT=""!(NXT'?.N) D
|
---|
17 | .S NODE=$G(@ARRY@(NXT))
|
---|
18 | .Q:NODE=""
|
---|
19 | .S PTIEN=+$P(NODE,"^") ;patient ien
|
---|
20 | .S PTNAME=$P(NODE,"^",2) ;patient name
|
---|
21 | .S PTAI=+$P(NODE,"^",3) ;patient team assignment ien (#404.42)
|
---|
22 | .;
|
---|
23 | .S PNODE=$G(^DPT(PTIEN,0))
|
---|
24 | .Q:PNODE=""
|
---|
25 | .S DFN=PTIEN
|
---|
26 | .D PID^VADPT6
|
---|
27 | .;S PID=VA("BID")
|
---|
28 | .S PID=$E(VA("PID"),1,3)_$E(VA("PID"),5,6)_$E(VA("PID"),8,12)
|
---|
29 | .;
|
---|
30 | .N CNAME,PINF,CLIEN
|
---|
31 | .S CNT=""
|
---|
32 | .F S CNT=$O(^SCPT(404.43,"B",PTAI,CNT)) Q:CNT=""!(CNT'?.N) D
|
---|
33 | ..D TPAR(PTAI,CNT,.PINF,.CNAME,.CLIEN,.PNAME,.ROLN,.PCAP)
|
---|
34 | Q
|
---|
35 | ;
|
---|
36 | TPAR(PTAI,START,PINF,CNAME,CLIEN,PNAME,ROLN,PCAP) ;
|
---|
37 | N PTPA,TPIEN,TPNODE,ROL,CIEN,ENROLL,OKAY,NEXT,LAST,PAIEN
|
---|
38 | I '$D(^SCPT(404.43,"B",PTAI)) Q "0^[Not Assigned]"
|
---|
39 | ; ^ no patient team position assignment
|
---|
40 | IF START="" D
|
---|
41 | .S PTPA=$O(^SCPT(404.43,"B",PTAI,START))
|
---|
42 | ELSE D
|
---|
43 | .S PTPA=START
|
---|
44 | I PTPA="" Q "0^[Not Assigned]"
|
---|
45 | S PTPAN=$G(^SCPT(404.43,PTPA,0)) ;patient team assignment
|
---|
46 | I PTPAN=""!(PTPAN=0) Q "0^[Not Assigned]"
|
---|
47 | I $P(PTPAN,"^",4)'="",$P(PTPAN,"^",4)<DT Q -1
|
---|
48 | S TPIEN=+$P(PTPAN,"^",2) ;team position ien (#404.57)
|
---|
49 | I '$D(^SCTM(404.57,TPIEN,0)) Q "0^[Not Assigned]"
|
---|
50 | S TPNODE=$G(^SCTM(404.57,TPIEN,0))
|
---|
51 | I TPNODE="" Q "0^[Not Assigned]"
|
---|
52 | S ROL=+$P(TPNODE,"^",3) ;role for position (ien)
|
---|
53 | Q:'$D(ROLE(ROL))&(ROLE'=1) -1
|
---|
54 | ; ^ not a selected role
|
---|
55 | S ROLN=$P($G(^SD(403.46,ROL,0)),U) ;role name
|
---|
56 | ;
|
---|
57 | S PCAP=$S($P(PTPAN,U,5)<1:"NPC",+$$OKPREC3^SCMCLK(TPIEN,DT)>0:" AP",1:"PCP") ;PC?
|
---|
58 | ;
|
---|
59 | D SETASCL^SCRPRAC2(TPIEN,.CNAME,.CLIEN)
|
---|
60 | ;next two lines commented off - SD*5.3*433
|
---|
61 | ;S ENROLL=$$ENRL(PTIEN,CIEN) ;enrolled in associated clinic
|
---|
62 | ;I 'ENROLL S CNAME="",CIEN=0
|
---|
63 | ;
|
---|
64 | S PAIEN=$$CHK(TPIEN)
|
---|
65 | I +PAIEN'=0 S PIEN=+PAIEN,PNAME=$P(PAIEN,"^",2) ; practitioner's name
|
---|
66 | ;SD*5.3*231
|
---|
67 | I +PAIEN=0 S PIEN=0,PNAME="[Inactive Position]"
|
---|
68 | ;
|
---|
69 | D GETPINF^SCRPPAT2(PTIEN,.CLIEN,.PINF) ;get patient info
|
---|
70 | S CNAME=$G(CNAME(0))
|
---|
71 | S PINF=$G(PINF(0))
|
---|
72 | I PINF="" D
|
---|
73 | .S PINF=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CNAME,CNAME,1)
|
---|
74 | I INACTIVE S @STORE@(INS,TIEN,"INACT")=""
|
---|
75 | S FLAG="Y"
|
---|
76 | S TINFO=$$TINF^SCRPTP(TIEN) ;team information
|
---|
77 | S INST=+$P(TINFO,"^") ;institution ien
|
---|
78 | S INAME=$P($G(^DIC(4,INST,0)),"^") ;institution name
|
---|
79 | S PHONE=$P(TINFO,"^",4) ;team phone
|
---|
80 | S PC=$P(TINFO,"^",3) ;primary care?
|
---|
81 | S TNAME=$P(TINFO,"^",2) ;team name
|
---|
82 | D TFORMAT^SCRPTP2(INST,INAME,TIEN,TNAME,PHONE,PC)
|
---|
83 | D FORMAT^SCRPTP(INS,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,CNAME,PINF,ROLN,PCAP)
|
---|
84 | N SCCNT
|
---|
85 | S SCCNT=0 F S SCCNT=$O(CNAME(SCCNT)) Q:SCCNT="" D FORMATAC^SCRPTP(SCCNT,CNAME(SCCNT),PINF(SCCNT),INS,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,ROLN,PCAP)
|
---|
86 | Q
|
---|
87 | ;
|
---|
88 | ENRL(PTIEN,CLIEN) ;FUNCTIONALITY DISABLED
|
---|
89 | ;
|
---|
90 | ;N FOUND,ENODE,EN,NXT
|
---|
91 | ;S FOUND=0
|
---|
92 | ;Q:'$D(^DPT(PTIEN,"DE","B",CLIEN)) FOUND
|
---|
93 | ;S EN=$O(^DPT(PTIEN,"DE","B",CLIEN,""))
|
---|
94 | ;Q:EN=""!'$D(^DPT(PTIEN,"DE",EN,1)) FOUND
|
---|
95 | ;S NXT=""
|
---|
96 | ;F S NXT=$O(^DPT(PTIEN,"DE",EN,1,NXT)) Q:(FOUND)!(NXT="")!(NXT'?.N) D
|
---|
97 | ;check if active enrollment
|
---|
98 | ;S ENODE=$G(^DPT(PTIEN,"DE",EN,1,NXT,0))
|
---|
99 | ;I $P(ENODE,"^",3)'="",$P(ENODE,"^",3)<DT+1!$P(ENODE,"^")>DT Q ;not active enrollment
|
---|
100 | ;; ^ discharge date ^ enrollment date
|
---|
101 | S FOUND=0
|
---|
102 | Q FOUND
|
---|
103 | ;
|
---|
104 | CHK(TPIEN) ;assigned to a position
|
---|
105 | ;TPIEN - ien of 404.57 Team Position file
|
---|
106 | ;returns: ien of 200 New Person file
|
---|
107 | N EN,PLIST,PERR,ERR,NAME
|
---|
108 | S PLIST="PLST",PERR="PRR"
|
---|
109 | K @PLIST,@PERR
|
---|
110 | S ERR=$$PRTP^SCAPMC8(TPIEN,,.PLIST,.PERR)
|
---|
111 | I '$D(@PERR) D
|
---|
112 | .S EN=$P($G(@PLIST@(1)),"^") ;ien of new person file
|
---|
113 | .S NAME=$P($G(@PLIST@(1)),"^",2) ; new person name
|
---|
114 | K @PLIST,@PERR
|
---|
115 | Q EN_"^"_NAME
|
---|
116 | ;
|
---|