Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCRPPAT2

SCRPPAT2.m

Go to the documentation of this file. 
  1. SCRPPAT2 ;ALB/CMM - Practitioner's Patients ; 12/12/00 3:46pm
  1.  ;;5.3;Scheduling;**41,48,174,181,177,231,433,297,526,520,1015**;AUG 13, 1993;Build 21
  1.  ;IHS/ANMC/LJF 11/02/2000 called IHS code to format display
  1.  ;
  1.  ;Listing of Practitioner's Patients
  1.  ;
  1. DRIVE ;
  1.  ;driver module
  1.  N PRAC,INF,ARRY,ERROR,NXT,OKAY,PIEN,TPRC
  1.  S ARRY="^TMP(""SCARRAY"","_$J_")",ERROR="ERR"
  1.  S TPRC="^TMP(""SCRP"",$J,""PRACT"")" M @TPRC=PRACT
  1.  K @ARRY,@ERROR,PRACT
  1.  I @TPRC=1 D ALL^SCRPPAT3 ;all practitioners selected
  1.  S NXT=0
  1.  F  S NXT=$O(@TPRC@(NXT)) Q:NXT=""!(NXT'?.N)  D
  1.  .I @TPRC=0 S PIEN=NXT
  1.  .I @TPRC=1 S PIEN=$P(@TPRC@(NXT),"^")
  1.  .K @ARRY,@ERROR
  1.  .S OKAY=$$PTPR^SCAPMC14(PIEN,"","","",ARRY,ERROR) ;patients for practitioner
  1.  .I '+OKAY Q
  1.  .D LOOPPT(ARRY,PIEN) ;loop through patients for practitioner
  1.  K @ARRY,@ERROR,@TPRC
  1.  K:SUMM @STORE@("PT")
  1.  Q
  1.  ;
  1. LOOPPT(ARY,PRAC) ;loop through patients for practitioner
  1.  ;ARY - array of patients for selected practitioner
  1.  ;PRAC - practitioner ien
  1.  N NXT,PIEN,TPIEN,PNAME,TPIEN,NODE,PTP,TPI,TPN,CLIEN,PTA,PTAN,TIEN
  1.  N PC,TNODE,TNAME,PINF,POSN,PRCP,CNAME
  1.  S NXT=0
  1.  F  S NXT=$O(@ARY@(NXT)) Q:NXT=""!(NXT'?.N)  D
  1.  .S NODE=$G(@ARY@(NXT))
  1.  .Q:NODE=""
  1.  .S PIEN=+$P(NODE,"^") ;ien of patient file entry
  1.  .S TPIEN=+$P(NODE,"^",3) ;ien of patient team position assignment
  1.  .S PTP=$G(^SCPT(404.43,TPIEN,0))
  1.  .Q:PTP=""
  1.  .S PTA=+$P(PTP,"^") ;patient team assignment ien (404.42)
  1.  .S PTAN=$G(^SCPT(404.42,PTA,0))
  1.  .Q:PTAN=""
  1.  .S TIEN=+$P(PTAN,"^",3) ;team file ien (404.51)
  1.  .I $G(TEAM)'=1,'$D(TEAM(TIEN)) Q  ;not a selected team
  1.  .S TNODE=$G(^SCTM(404.51,TIEN,0))
  1.  .Q:TNODE=""  I $G(INST)'=1,'$D(INST(+$P(TNODE,U,7))) Q
  1.  .S TNAME=$P(TNODE,"^") ;team name
  1.  .S TPI=+$P(PTP,"^",2) ;Team Position file ien (404.57)
  1.  .S TPN=$G(^SCTM(404.57,TPI,0))
  1.  .Q:TPN=""
  1.  .I $G(ROLE)'=1,'$D(ROLE(+$P(TPN,U,3))) Q  ;not a selected role
  1.  .S POSN=$P(TPN,"^") ;position name
  1.  .D SETASCL^SCRPRAC2(TPI,.CNAME,.CLIEN)  ;get clinics from multiple
  1.  .;S CLIEN=+$P(TPN,"^",9) ;associated clinic ien
  1.  .;commented next line off - clinic enrollment no longer needed SD*5.3*433
  1.  .;D CECHK(CLIEN,.CNAME,PIEN) ;is patient enrolled in associated clinic?
  1.  .;S CNAME=$P($G(^SC(CLIEN,0)),"^")  ; SD*5.3*433 remove enroll check
  1.  .S PC=$S($P(PTP,"^",5)=0:0,1:1) ;primary care position 1or2-yes/0-no
  1.  .S PNAME=$P($G(^VA(200,+PRAC,0)),"^") ;practitioner name
  1.  .Q:PNAME=""
  1.  .S PRCP=$P($$OKPREC2^SCMCLK(TPI,DT),U,2)
  1.  .D GETPINF(PIEN,.CLIEN,.PINF)  ;get patient information and appointments
  1.  .S CNAME=$G(CNAME(0))  ;first line will capture position information
  1.  .S PINF=$G(PINF(0))
  1.  .I PINF=""  D 
  1.  ..S PINF=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CNAME,CNAME,1)
  1.  .D FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
  1.  .D SETFORM(PIEN,.CNAME,.PINF)
  1. SETFORM(PIEN,CNAME,PINF)  ;Format for clinic info only for multiples
  1.  N SCCNT
  1.  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)
  1.  Q
  1. GETPINF(PIEN,CLIEN,PINF)  ;get patient info 
  1.  N SCCNT
  1.  S SCCNT="" F  S SCCNT=$O(CLIEN(SCCNT)) Q:SCCNT=""  D 
  1.  .S PINF(SCCNT)=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CLIEN(SCCNT),CNAME(SCCNT),1)
  1.  Q
  1.  ;
  1. CECHK(CLIEN,CNAME,PIEN) ;should no longer be used as of patch SD*5.3*433
  1.  ;CLIEN - clinic ien
  1.  ;CNAME - clinic name returned if patient is enrolled in clien clinic
  1.  ;PIEN - patien ien
  1.  ;
  1.  N EN,NODE
  1.  S CNAME=""
  1.  I $D(^DPT(PIEN,"DE","B",CLIEN)) D
  1.  .;enrolled at one time, check if discharged
  1.  .S EN=$O(^DPT(PIEN,"DE","B",CLIEN,""))
  1.  .S NODE=$G(^DPT(PIEN,"DE",EN,0))
  1.  .Q:NODE=""
  1.  .I $P(NODE,"^",3)="" S CNAME=$P($G(^SC(CLIEN,0)),"^") ;clinic name
  1.  .I $P(NODE,"^",3)'="",$P(NODE,"^",3)>DT S CNAME=$P($G(^SC(CLIEN,0)),"^") ;clinic name
  1.  Q
  1.  ;
  1. FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display
  1.  ;CNAME - clinic name
  1.  ;PINF - patient/clinic data
  1.  ;PC - primary care 1/0
  1.  ;TIEN - team file ien (#404.51)
  1.  ;TNAME - team name
  1.  ;PRAC - practitioner ien (#200)
  1.  ;PNAME - practitioner name
  1.  ;POSN - position name
  1.  ;TPI - team position ien (#404.57)
  1.  ;PRCP - preceptor name
  1.  ;
  1.  N IIEN,INAME,ERR
  1.  S ERR=$$SETUP^SCRPPAT3(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
  1.  I ERR Q
  1.  ;
  1.  I SORT=1 D STOR(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI) ;sort division,team,practitioner
  1.  I SORT=2 D STOR(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI) ;sort division,practitioner,team
  1.  I SORT=3 D STOR(1,PRAC,1,PINF,PNAME,"T3",TPI)
  1.  Q
  1.  ;
  1. FORMATAC(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display
  1.  ;CNAME - clinic name
  1.  ;PINF - patient/clinic data
  1.  ;PC - primary care 1/0
  1.  ;TIEN - team file ien (#404.51)
  1.  ;TNAME - team name
  1.  ;PRAC - practitioner ien (#200)
  1.  ;PNAME - practitioner name
  1.  ;POSN - position name
  1.  ;TPI - team position ien (#404.57)
  1.  ;PRCP - preceptor name
  1.  ;
  1.  N IIEN,INAME,ERR
  1.  S ERR=$$SETUP^SCRPPAT3(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
  1.  I ERR Q
  1.  ;
  1.  I SORT=1 D STORA(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI,SCCNT) ;sort division,team,practitioner
  1.  I SORT=2 D STORA(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI,SCCNT) ;sort division,practitioner,team
  1.  I SORT=3 D STORA(1,PRAC,1,PINF,PNAME,"T3",TPI,SCCNT)
  1.  Q
  1.  ;
  1. STOR(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ;
  1.  ;IIEN - ien institution
  1.  ;SEC - second sort subscript, IEN team or IEN practitioner
  1.  ;TRD - third sort subscript, IEN team or IEN practitioner
  1.  ;PINF - patient/clinic info
  1.  ;PNAME - practitioner name
  1.  ;TNAME - team name
  1.  ;TPI - team position ien
  1.  ;
  1.  N PIEN,PTNAME,PID
  1.  S PIEN=+$P(PINF,"^") ;patient ien 
  1.  S PTNAME=$E($P(PINF,"^",2),1,10) ;patient name
  1.  Q:$D(@STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN))
  1.  S @STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN)=""
  1.  I 'SUMM,'$D(@STORE@("PTOT",IIEN,SEC,TRD,PIEN)) D
  1.  .;count each unique patient for any given practitioner for grand total
  1.  .S @STORE@("PTOT",IIEN,SEC,TRD,PIEN)=""
  1.  .S @STORE@("TOTAL",IIEN,PRAC,0)=$G(@STORE@("TOTAL",IIEN,PRAC,0))+1 ;patient count by practitioner
  1.  ;
  1.  S @STORE@("TOTAL",IIEN,PRAC,$S(SORT=3:1,1:TIEN),TPI)=$G(@STORE@("TOTAL",IIEN,PRAC,$S(SORT=3:1,1:TIEN),TPI))+1 ;patient count by practitioner and team
  1.  Q:SUMM
  1.  ;
  1.  D FORMAT^BSDSCPAT Q  ;IHS/ANMC/LJF 11/2/2000
  1.  ;
  1.  S @STORE@(IIEN,SEC,TRD,TPI,PIEN)=PTNAME
  1.  S PID=$P(PINF,"^",3),PID=$TR(PID,"-","")
  1.  S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),13)=PID ;ssn
  1.  S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),25)=$P(PINF,"^",4) ;means test status
  1.  S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),31)=$P(PINF,"^",5) ;eligibility
  1.  ;Removed by patch 174
  1.  ;S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),40)=$P(PINF,"^",6) ;patient status
  1.  S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),42)=$P(PINF,"^",8) ;last appt
  1.  S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),54)=$P(PINF,"^",9) ;nxt appt
  1.  S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),66)=$E(CNAME,1,15) ;clinic
  1.  Q
  1. STORA(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ;
  1.  I '$D(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT))  D
  1.  .S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),42)=$P(PINF,"^",8) ;last appt
  1.  .S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),54)=$P(PINF,"^",9) ;nxt appt
  1.  .S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),66)=$E(CNAME,1,15) ;clinic
  1.  .Q
  1.  Q