source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPRAC2.m@ 1423

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1SCRPRAC2 ;ALB/CMM - Practitioner Demographics continued ; 29 Jun 99 04:11PM
2 ;;5.3;Scheduling;**41,177,520**;AUG 13, 1993;Build 26
3 ;
4 ;Practitioner Demographics Report
5 ;
6GATHER(PARRAY,PRAC) ;
7 ;get practitioner data
8 N ANODE,TIEN,PNAME,POS,STROL,USCL,TNAME,MAX,PHONE,ASSIGN,ROOM,SERV
9 N NODE,PIEN,CNAME,PCLASS,PRCP,PRCPCNT,SCLN,SCI,NXT,PRCPCT,PRCPOS
10 N PRCPTE,SCDT,SCRATCH
11 S NXT=0
12 F S NXT=$O(@PARRAY@(NXT)) Q:NXT=""!(NXT'?.N) D
13 .S (PNAME,PHONE,SERV,ROOM)=""
14 .D PINFO(PRAC,.PNAME,.PHONE,.ROOM,.SERV)
15 .;get provider name, office phone, room, service/section, person class
16 .;
17 .S ANODE=$G(@PARRAY@(NXT))
18 .Q:ANODE=""
19 .S PIEN=+$P(ANODE,"^") ;position ien
20 .;
21 .;Get precepted provider information
22 .S PRCPCNT=0
23 .S SCDT="SCDT",(SCDT("BEGIN"),SCDT("END"))="DT",SCDT("INCL")=0
24 .K ^TMP("SCRATCH",$J),^TMP("SCRATCH1",$J) S SCI="^TMP(""SCRATCH1"",$J)"
25 .S SCI=$$PRECHIS^SCMCLK(PIEN,.SCDT,SCI),SCI=0
26 .F S SCI=$O(^TMP("SCRATCH1",$J,SCI)) Q:'SCI D
27 ..N SCPRCD,SCTP
28 ..S SCPRCD=^TMP("SCRATCH1",$J,SCI),SCTP=$P(SCPRCD,U,3)
29 ..S PRCPTE=$P(SCPRCD,U,2) S:'$L(PRCPTE) PRCPTE="[unknown]"
30 ..S PRCPOS=$P($G(SCRATCH(1)),U,4)
31 ..S PRCPCT=$$PCPOSCNT^SCAPMCU1(SCTP,DT,0)
32 ..S PRCPCNT=PRCPCNT+PRCPCT
33 ..S ^TMP("SCRATCH",$J,PRCPTE,SCTP)=PRCPOS_U_PRCPCT
34 ..Q
35 .;
36 .S POS=$P(ANODE,"^",2) ;position name
37 .S STROL=$P(ANODE,"^",8) ;standard role name
38 .S USCL=$P(ANODE,"^",10) ;user class name
39 .S NODE=$G(^SCTM(404.57,PIEN,0))
40 .S MAX=$P(NODE,"^",8) ;max patient assignments to position
41 .S ASSIGN=+$$PCPOSCNT^SCAPMCU1(PIEN,DT,0) ;assigned patients
42 .N CNAME,SCCLIEN
43 .D SETASCL(PIEN,.CNAME,.SCCLIEN) ;associated clinics
44 .;
45 .;Get preceptor
46 .S PRCP=$P($$OKPREC2^SCMCLK(PIEN,DT),U,2)
47 .;
48 .S TIEN=+$P(ANODE,"^",3) ;team ien
49 .S TNAME=$P($G(^SCTM(404.51,TIEN,0)),"^") ;team name
50 .;
51 .;Set array for output
52 .S SCLN=0
53 .D SET1("Name",PNAME),SET2("Serv./Sect.",SERV)
54 .D SET1("Team",TNAME),SET2("Position",POS)
55 .D SET1("Role",STROL),SET2("User Class",USCL)
56 .D SET1("Room",ROOM),SET2("Pts. Allowed",MAX)
57 .D SET1("Phone",PHONE),SET2("Pts. Assigned",ASSIGN)
58 .I $L($G(PRCP)) D SET3(1,"Preceptor: "_PRCP)
59 .D SET3(4,"Assoc. Clinic: ")
60 .D SETCNAME(.CNAME)
61 .I $L(PCLASS(1)) D
62 ..D SET3(4,"Person"),SET3(5,"Class: "_PCLASS(1)) D
63 ..I $L(PCLASS(2)) D SET3(15,PCLASS(2)) D
64 ...I $L(PCLASS(3)) D SET3(18,PCLASS(3))
65 ...Q
66 ..Q
67 .Q:'$D(^TMP("SCRATCH",$J))
68 .D SET3(1,"")
69 .D SET4("Precepted Provider","Precepted Position","Pts. Precepted")
70 .S SCI="",$P(SCI,"-",31)="" D SET4(SCI,SCI,$E(SCI,1,14))
71 .S PRCPTE="" F S PRCPTE=$O(^TMP("SCRATCH",$J,PRCPTE)) Q:PRCPTE="" D
72 ..S SCTP=0 F S SCTP=$O(^TMP("SCRATCH",$J,PRCPTE,SCTP)) Q:'SCTP D
73 ...S PRCPOS=^TMP("SCRATCH",$J,PRCPTE,SCTP)
74 ...S PRCPCT=+$P(PRCPOS,U,2),PRCPOS=$P(PRCPOS,U)
75 ...D SET4(PRCPTE,PRCPOS,PRCPCT_" ")
76 ...Q
77 ..Q
78 .D SET3(1,"") S SCI=" Total precepted patients: "_PRCPCNT
79 .S $E(SCI,37)=$J(("Total assigned/precepted patients: "_(PRCPCNT+ASSIGN)),42)
80 .D SET3(1,SCI)
81 .K ^TMP("SCRATCH",$J),^TMP("SCRATCH1",$J)
82 .Q
83 Q
84 ;
85SETASCL(PIEN,CNAME,SCCLIEN) ;SET ASSOCIATED CLINICS
86 N I,CNT1
87 S CNT1=0,I=0
88 F S I=$O(^SCTM(404.57,PIEN,5,I)) Q:'I D
89 .S SCCLIEN(CNT1)=I,CNAME(CNT1)=$P($G(^SC(I,0)),U),CNT1=CNT1+1
90 Q
91SET1(LABEL,VALUE) ;Set output line
92 S SCLN=SCLN+1
93 S @STORE@(PNAME,PIEN,SCLN)=$J(LABEL,9)_": "_$E(VALUE,1,26)
94 Q
95 ;
96SET2(LABEL,VALUE) ;Set second column of output line
97 S $E(@STORE@(PNAME,PIEN,SCLN),40)=$J(LABEL,13)_": "_$E(VALUE,1,26)
98 Q
99 ;
100SET3(COL,VALUE) ;Set output line
101 N SCX
102 S SCLN=SCLN+1,SCX="",$E(SCX,COL)=$E(VALUE,1,(80-(COL-1)))
103 S @STORE@(PNAME,PIEN,SCLN)=SCX
104 Q
105 ;
106SET4(V1,V2,V3) ;Set output line
107 S SCLN=SCLN+1,V1=" "_V1,$E(V1,35)=V2,$E(V1,67)=$J(V3,14)
108 S @STORE@(PNAME,PIEN,SCLN)=V1
109 Q
110 ;
111SETCNAME(CNAME) ;associated clinics
112 N A
113 S A="" F S A=$O(CNAME(A)) Q:A="" D SET3(12,CNAME(A))
114 Q
115 ;
116PINFO(VAE,PRACT,OPH,ROOM,SERV) ;
117 ;practitioner information from new person file
118 S PRACT=$P($G(^VA(200,VAE,0)),"^") ;practitioner name
119 S OPH=$P($G(^VA(200,VAE,.13)),"^",2) ;office phone
120 S ROOM=$P($G(^VA(200,VAE,.14)),"^") ;room
121 S SERV=$P($G(^VA(200,VAE,5)),"^") ;service/section ien
122 S SERV=$P($G(^DIC(49,+SERV,0)),"^") ;service/section name
123 S PCLASS=$$GET^XUA4A72(VAE) ;Person class
124 N SCI F SCI=1,2,3 S PCLASS(SCI)=$P(PCLASS,U,(SCI+1))
125 Q
Note: See TracBrowser for help on using the repository browser.