| 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
|
---|