Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPRAC2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPRAC2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPRAC2.m
r613 r623 1 SCRPRAC2 ;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 ; 6 GATHER(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 ; 85 SETASCL(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 91 SET1(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 ; 96 SET2(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 ; 100 SET3(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 ; 106 SET4(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 ; 111 SETCNAME(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 ; 116 PINFO(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 1 SCRPRAC2 ;ALB/CMM - Practitioner Demographics continued ; 29 Jun 99 04:11PM 2 ;;5.3;Scheduling;**41,177**;AUG 13, 1993 3 ; 4 ;Practitioner Demographics Report 5 ; 6 GATHER(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 .S CNAME=$P($G(^SC(+$P(NODE,U,9),0)),U) ;associated clinic 43 .; 44 .;Get preceptor 45 .S PRCP=$P($$OKPREC2^SCMCLK(PIEN,DT),U,2) 46 .; 47 .S TIEN=+$P(ANODE,"^",3) ;team ien 48 .S TNAME=$P($G(^SCTM(404.51,TIEN,0)),"^") ;team name 49 .; 50 .;Set array for output 51 .S SCLN=0 52 .D SET1("Name",PNAME),SET2("Serv./Sect.",SERV) 53 .D SET1("Team",TNAME),SET2("Position",POS) 54 .D SET1("Role",STROL),SET2("User Class",USCL) 55 .D SET1("Room",ROOM),SET2("Pts. Allowed",MAX) 56 .D SET1("Phone",PHONE),SET2("Pts. Assigned",ASSIGN) 57 .I $L($G(PRCP)) D SET3(1,"Preceptor: "_PRCP) 58 .D SET3(4,"Assoc.") 59 .D SET3(4,"Clinic: "_CNAME) 60 .I $L(PCLASS(1)) D 61 ..D SET3(4,"Person"),SET3(5,"Class: "_PCLASS(1)) D 62 ..I $L(PCLASS(2)) D SET3(15,PCLASS(2)) D 63 ...I $L(PCLASS(3)) D SET3(18,PCLASS(3)) 64 ...Q 65 ..Q 66 .Q:'$D(^TMP("SCRATCH",$J)) 67 .D SET3(1,"") 68 .D SET4("Precepted Provider","Precepted Position","Pts. Precepted") 69 .S SCI="",$P(SCI,"-",31)="" D SET4(SCI,SCI,$E(SCI,1,14)) 70 .S PRCPTE="" F S PRCPTE=$O(^TMP("SCRATCH",$J,PRCPTE)) Q:PRCPTE="" D 71 ..S SCTP=0 F S SCTP=$O(^TMP("SCRATCH",$J,PRCPTE,SCTP)) Q:'SCTP D 72 ...S PRCPOS=^TMP("SCRATCH",$J,PRCPTE,SCTP) 73 ...S PRCPCT=+$P(PRCPOS,U,2),PRCPOS=$P(PRCPOS,U) 74 ...D SET4(PRCPTE,PRCPOS,PRCPCT_" ") 75 ...Q 76 ..Q 77 .D SET3(1,"") S SCI=" Total precepted patients: "_PRCPCNT 78 .S $E(SCI,37)=$J(("Total assigned/precepted patients: "_(PRCPCNT+ASSIGN)),42) 79 .D SET3(1,SCI) 80 .K ^TMP("SCRATCH",$J),^TMP("SCRATCH1",$J) 81 .Q 82 Q 83 ; 84 SET1(LABEL,VALUE) ;Set output line 85 S SCLN=SCLN+1 86 S @STORE@(PNAME,PIEN,SCLN)=$J(LABEL,9)_": "_$E(VALUE,1,26) 87 Q 88 ; 89 SET2(LABEL,VALUE) ;Set second column of output line 90 S $E(@STORE@(PNAME,PIEN,SCLN),40)=$J(LABEL,13)_": "_$E(VALUE,1,26) 91 Q 92 ; 93 SET3(COL,VALUE) ;Set output line 94 N SCX 95 S SCLN=SCLN+1,SCX="",$E(SCX,COL)=$E(VALUE,1,(80-(COL-1))) 96 S @STORE@(PNAME,PIEN,SCLN)=SCX 97 Q 98 ; 99 SET4(V1,V2,V3) ;Set output line 100 S SCLN=SCLN+1,V1=" "_V1,$E(V1,35)=V2,$E(V1,67)=$J(V3,14) 101 S @STORE@(PNAME,PIEN,SCLN)=V1 102 Q 103 ; 104 PINFO(VAE,PRACT,OPH,ROOM,SERV) ; 105 ;practitioner information form new person file 106 S PRACT=$P($G(^VA(200,VAE,0)),"^") ;practitioner name 107 S OPH=$P($G(^VA(200,VAE,.13)),"^",2) ;office phone 108 S ROOM=$P($G(^VA(200,VAE,.14)),"^") ;room 109 S SERV=$P($G(^VA(200,VAE,5)),"^") ;service/section ien 110 S SERV=$P($G(^DIC(49,+SERV,0)),"^") ;service/section name 111 S PCLASS=$$GET^XUA4A72(VAE) ;Person class 112 N SCI F SCI=1,2,3 S PCLASS(SCI)=$P(PCLASS,U,(SCI+1)) 113 Q
Note:
See TracChangeset
for help on using the changeset viewer.
