Changeset 636 for FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPPAT2.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• SCHEDULING-SD-SC/SCRPPAT2.m (modified) (7 diffs)

FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPPAT2.m

@@ -1 +1 @@
 SCRPPAT2 ;ALB/CMM - Practitioner's Patients ; 12/12/00 3:46pm
- ;;5.3;Scheduling;**41,48,174,181,177,231,433,297,526,520**;AUG 13, 1993;Build 26
+ ;;5.3;Scheduling;**41,48,174,181,177,231,433,297**;AUG 13, 1993
  ;
  ;Listing of Practitioner's Patients
@@ -26 +26 @@
  ;ARY - array of patients for selected practitioner
  ;PRAC - practitioner ien
- N NXT,PIEN,TPIEN,PNAME,TPIEN,NODE,PTP,TPI,TPN,CLIEN,PTA,PTAN,TIEN
- N PC,TNODE,TNAME,PINF,POSN,PRCP,CNAME
+ N NXT,PIEN,TPIEN,PNAME,TPIEN,NODE,PTP,TPI,TPN,CLIEN,CNAME,PTA,PTAN,TIEN
+ N PC,TNODE,TNAME,PINF,POSN,PRCP
  S NXT=0
  F  S NXT=$O(@ARY@(NXT)) Q:NXT=""!(NXT'?.N)  D
@@ -49 +49 @@
  .I $G(ROLE)'=1,'$D(ROLE(+$P(TPN,U,3))) Q  ;not a selected role
  .S POSN=$P(TPN,"^") ;position name
- .D SETASCL^SCRPRAC2(TPI,.CNAME,.CLIEN)  ;get clinics from multiple
- .;S CLIEN=+$P(TPN,"^",9) ;associated clinic ien
+ .S CLIEN=+$P(TPN,"^",9) ;associated clinic ien
  .;commented next line off - clinic enrollment no longer needed SD*5.3*433
  .;D CECHK(CLIEN,.CNAME,PIEN) ;is patient enrolled in associated clinic?
- .;S CNAME=$P($G(^SC(CLIEN,0)),"^")  ; SD*5.3*433 remove enroll check
+ .S CNAME=$P($G(^SC(CLIEN,0)),"^")  ; SD*5.3*433 remove enroll check
  .S PC=$S($P(PTP,"^",5)=0:0,1:1) ;primary care position 1or2-yes/0-no
  .S PNAME=$P($G(^VA(200,+PRAC,0)),"^") ;practitioner name
  .Q:PNAME=""
  .S PRCP=$P($$OKPREC2^SCMCLK(TPI,DT),U,2)
- .D GETPINF(PIEN,.CLIEN,.PINF)  ;get patient information and appointments
- .S CNAME=$G(CNAME(0))  ;first line will capture position information
- .S PINF=$G(PINF(0))
- .I PINF=""  D 
- ..S PINF=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CNAME,CNAME,1)
- .D FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
- .D SETFORM(PIEN,.CNAME,.PINF)
-SETFORM(PIEN,CNAME,PINF)  ;Format for clinic info only for multiples
- N SCCNT
- S SCCNT=0 F  S SCCNT=$O(PINF(SCCNT)) Q:SCCNT=""  D FORMATAC(CNAME(SCCNT),PINF(SCCNT),PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
- Q
-GETPINF(PIEN,CLIEN,PINF)  ;get patient info 
- N SCCNT
- S SCCNT="" F  S SCCNT=$O(CLIEN(SCCNT)) Q:SCCNT=""  D 
- .S PINF(SCCNT)=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CLIEN(SCCNT),CNAME(SCCNT),1)
+ .S PINF=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CLIEN,1)
+ .;$$PDATA returns pt name,pid,mt,pelig,status,status date,last appt,nxt appt
+ .D FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ;formats data for display
  Q
  ;
-CECHK(CLIEN,CNAME,PIEN) ;should no longer be used as of patch SD*5.3*433
+CECHK(CLIEN,CNAME,PIEN) ;
  ;CLIEN - clinic ien
  ;CNAME - clinic name returned if patient is enrolled in clien clinic
@@ -112 +99 @@
  Q
  ;
-FORMATAC(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display
- ;CNAME - clinic name
- ;PINF - patient/clinic data
- ;PC - primary care 1/0
- ;TIEN - team file ien (#404.51)
- ;TNAME - team name
- ;PRAC - practitioner ien (#200)
- ;PNAME - practitioner name
- ;POSN - position name
- ;TPI - team position ien (#404.57)
- ;PRCP - preceptor name
- ;
- N IIEN,INAME,ERR
- S ERR=$$SETUP^SCRPPAT3(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
- I ERR Q
- ;
- I SORT=1 D STORA(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI,SCCNT) ;sort division,team,practitioner
- I SORT=2 D STORA(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI,SCCNT) ;sort division,practitioner,team
- I SORT=3 D STORA(1,PRAC,1,PINF,PNAME,"T3",TPI,SCCNT)
- Q
- ;
-STOR(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ;
+STOR(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI) ;
  ;IIEN - ien institution
  ;SEC - second sort subscript, IEN team or IEN practitioner
@@ -144 +110 @@
  N PIEN,PTNAME,PID
  S PIEN=+$P(PINF,"^") ;patient ien 
- S PTNAME=$E($P(PINF,"^",2),1,10) ;patient name
+ S PTNAME=$E($P(PINF,"^",2),1,15) ;patient name
  Q:$D(@STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN))
  S @STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN)=""
+ ;
  I 'SUMM,'$D(@STORE@("PTOT",IIEN,SEC,TRD,PIEN)) D
  .;count each unique patient for any given practitioner for grand total
@@ -157 +124 @@
  S @STORE@(IIEN,SEC,TRD,TPI,PIEN)=PTNAME
  S PID=$P(PINF,"^",3),PID=$TR(PID,"-","")
- S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),13)=PID ;ssn
+ S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),18)=$E(PID,6,10) ;last 4 pid - 5 places is for any pseudo
  S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),25)=$P(PINF,"^",4) ;means test status
  S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),31)=$P(PINF,"^",5) ;eligibility
@@ -166 +133 @@
  S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),66)=$E(CNAME,1,15) ;clinic
  Q
-STORA(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ;
- I '$D(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT))  D
- .S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),42)=$P(PINF,"^",8) ;last appt
- .S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),54)=$P(PINF,"^",9) ;nxt appt
- .S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),66)=$E(CNAME,1,15) ;clinic
- .Q
- Q