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

SCRPEC2.m

Go to the documentation of this file. 
  1. SCRPEC2 ;ALB/CMM - Detail List of Pts & Enroll Clinics Continued ; 29 Jun 99  04:11PM
  1.  ;;5.3;Scheduling;**41,140,174,177,526,1015**;AUG 13, 1993;Build 21
  1.  ;IHS/ANMC/LJF 10/26/2000 call IHS code to format patient data
  1.  ;                        and for column headings
  1.  ;             11/01/2000 added 2nd primary care provider
  1.  ;
  1.  ;Detailed Listing of Patients and Their Enrolled Clinics Report
  1.  ;
  1. PAT(TIEN,PTLIST) ;
  1.  ;TIEN - team ien
  1.  ;PTLIST - array holding patients assigned to team TIEN
  1.  ;
  1.  N PTIEN,ENT,NODE,OKAY,CLLIST,ERR,PC
  1.  S ENT=0,CLLIST="LIST2",ERR="ERROR2"
  1.  K @CLLIST
  1.  F  S ENT=$O(@PTLIST@(ENT)) Q:ENT=""!(ENT'?.N)  D
  1.  .S NODE=$G(@PTLIST@(ENT))
  1.  .Q:NODE=""
  1.  .S PTIEN=+$P(NODE,"^") ;patient ien
  1.  .S PC=$$PCASSIGN(PTIEN,TIEN)
  1.  .Q:PC'=ASSUN  ;not selected assigned/unassigned primary care
  1.  .K @CLLIST
  1.  .S OKAY=$$CLPT^SCAPMC29(PTIEN,"","",.CLLIST,.ERR)
  1.  .;all clinics for patient PTIEN
  1.  .Q:'OKAY
  1.  .D KEEP(TIEN,PTIEN,.CLLIST)
  1.  K @CLLIST
  1.  Q
  1.  ;
  1. KEEP(TIEN,PTIEN,CLLIST) ;keep data for report
  1.  ;TIEN - team ien
  1.  ;PTIEN - patient ien
  1.  ;CLLIST - array holding clinics for patient PTIEN
  1.  ;
  1.  N ENT,TNAME,INS,NODE,INAME,PDATA,NODE,CIEN,CNAME,PNAME
  1.  N SCPCPR,SCPCAP,SCI,PCLIST
  1.  S TNAME=$P($G(^SCTM(404.51,TIEN,0)),"^") ;team name
  1.  S INS=+$P($G(^SCTM(404.51,TIEN,0)),"^",7) ;institution ien
  1.  S INAME=$P($G(^DIC(4,INS,0)),"^") ;institution name
  1.  S PNAME=$P($G(^DPT(PTIEN,0)),"^") ;patient name
  1.  K ^TMP("SC",$J,PTIEN)
  1.  S SCI=$$GETALL^SCAPMCA(PTIEN) D
  1.  .;Name of PC Provider
  1.  .S SCPCPR=$P($G(^TMP("SC",$J,PTIEN,"PCPR",1)),U,2)
  1.  .;Name of Associate Provider
  1.  .S SCPCAP=$P($G(^TMP("SC",$J,PTIEN,"PCAP",1)),U,2)
  1.  .;Name of 2nd Primary Care Provider;IHS/ANMC/LJF 11/1/2000
  1.  .S SC2PCP=$P($G(^TMP("SC",$J,PTIEN,"NPCPR",1)),U,2)  ;IHS/ANMC/LJF 11/1/2000
  1.  .Q
  1.  ;
  1.  S ENT=0
  1.  F  S ENT=$O(@CLLIST@(ENT)) Q:ENT=""!(ENT'?.N)  D
  1.  .S NODE=$G(@CLLIST@(ENT))
  1.  .S CIEN=+$P(NODE,"^") ;clinic ien
  1.  .I CLINIC'=1,'$D(CLINIC(CIEN)) Q
  1.  .S CNAME=$P(NODE,"^",2) ;clinic name
  1.  .D SETUP(INS,INAME,TIEN,TNAME,PTIEN,PNAME,CIEN,CNAME)
  1.  .S PDATA=$$PDATA^SCRPEC(PTIEN,CIEN,1)
  1.  .S $P(PDATA,U,9)=SCPCPR,$P(PDATA,U,10)=SCPCAP
  1.  .S $P(PDATA,U,11)=SC2PCP  ;IHS/ANMC/LJF 11/1/2000
  1.  .;name^pid^mt^pelig^pstat^statd^last^next^pc prov.^assoc. prov.
  1.  .D FORMAT(PTIEN,INS,TIEN,PDATA,CNAME,CIEN)
  1.  Q
  1.  ;
  1. SETUP(INS,INAME,TIEN,TNAME,PTIEN,PNAME,CIEN,CNAME) ;
  1.  ;INS - institution ien
  1.  ;INAME - institution name
  1.  ;TIEN - team ien
  1.  ;TNAME - team name
  1.  ;PTIEN - patient ien
  1.  ;PNAME - patient name
  1.  ;CIEN - clinic ien
  1.  ;CNAME - clinic name
  1.  ;
  1.  I INAME="" S INAME="[BAD DATA]"
  1.  I TNAME="" S TNAME="[BAD DATA]"
  1.  I CNAME="" S CNAME="[BAD DATA]"
  1.  I PNAME="" S PNAME="[BAD DATA]"
  1.  I '$D(@STORE@("I",INAME,INS)) S @STORE@("I",INAME,INS)="",@STORE@(INS)="Division: "_INAME
  1.  I '$D(@STORE@("T",INS,TNAME,TIEN)) S @STORE@("T",INS,TNAME,TIEN)="",@STORE@(INS,TIEN)="Team: "_TNAME
  1.  I '$D(@STORE@("C",INS,TIEN,CNAME,CIEN)) S @STORE@("C",INS,TIEN,CNAME,CIEN)="" ;D HEADER(INS,TIEN,CIEN)
  1.  I '$D(@STORE@("PT",INS,TIEN,CIEN,PNAME,PTIEN)) S @STORE@("PT",INS,TIEN,CIEN,PNAME,PTIEN)=""
  1.  Q
  1.  ;
  1. PCASSIGN(DFN,TIEN) ;patient assigned to team as primary care
  1.  ;DFN - patient ien
  1.  ;TIEN - team ien
  1.  ;1 - yes
  1.  ;0 - no
  1.  ;
  1.  N ADATE,ENTRY,PC
  1.  S PC=0
  1.  I '$D(^SCPT(404.42,"AIDT",DFN,TIEN)) Q PC
  1.  S ADATE=$O(^SCPT(404.42,"AIDT",DFN,TIEN,"")) ; -team assignemtn date
  1.  S ENTRY=$O(^SCPT(404.42,"AIDT",DFN,TIEN,ADATE,"")) ;patient team assignemtn ien
  1.  I $P($G(^SCPT(404.42,+ENTRY,0)),"^",8)=1 S PC=1
  1.  Q PC
  1.  ;
  1.  D HEADER^BSDSCEC Q  ;IHS/ANMC/LJF 10/26/2000
  1.  N HLD
  1.  S HLD="H0"
  1.  S $E(@STORE@("SUBHEADER",HLD),25)="M.T."
  1.  S $E(@STORE@("SUBHEADER",HLD),31)="Prim"
  1.  ;Removed by patch 174
  1.  ;S $E(@STORE@("SUBHEADER",HLD),31)="Pat"
  1.  ;S $E(@STORE@("SUBHEADER",HLD),36)="Status"
  1.  S $E(@STORE@("SUBHEADER",HLD),42)="Last"
  1.  S $E(@STORE@("SUBHEADER",HLD),54)="Next"
  1.  S $E(@STORE@("SUBHEADER",HLD),66)="Enrolled"
  1.  S $E(@STORE@("SUBHEADER",HLD),95)="Primary Care"
  1.  S $E(@STORE@("SUBHEADER",HLD),115)="Associate"
  1.  S HLD="H1"
  1.  S @STORE@("SUBHEADER",HLD)="Patient Name"
  1.  S $E(@STORE@("SUBHEADER",HLD),16)="Pt ID"
  1.  S $E(@STORE@("SUBHEADER",HLD),25)="Stat"
  1.  S $E(@STORE@("SUBHEADER",HLD),31)="Elig"
  1.  ;Removed by patch 174
  1.  ;S $E(@STORE@("SUBHEADER",HLD),31)="Stat"
  1.  ;S $E(@STORE@("SUBHEADER",HLD),36)="Date"
  1.  S $E(@STORE@("SUBHEADER",HLD),42)="Appt"
  1.  S $E(@STORE@("SUBHEADER",HLD),54)="Appt"
  1.  S $E(@STORE@("SUBHEADER",HLD),66)="Clinic"
  1.  S $E(@STORE@("SUBHEADER",HLD),95)="Provider"
  1.  S $E(@STORE@("SUBHEADER",HLD),115)="Provider"
  1.  S HLD="H2"
  1.  S $P(@STORE@("SUBHEADER",HLD),"=",133)=""
  1.  Q
  1.  ;
  1. FORMAT(PTIEN,INS,TIEN,PDATA,CNAME,CIEN) ;format data for report
  1.  ;PTIEN - patient ien
  1.  ;INS - institution ien
  1.  ;TIEN - team ien
  1.  ;PDATA - pt name^pid^mt^pelig^pstat^statd^last^next^pc prov.^assoc. prov.
  1.  ;CNAME - clinic name
  1.  ;CIEN - clinic ien
  1.  ;
  1.  D FORMAT^BSDSCEC(PTIEN,INS,TIEN,PDATA,CNAME,CIEN) Q  ;IHS/ANMC/LJF 10/26/2000
  1.  S @STORE@(INS,TIEN,CIEN,PTIEN)=$E($P(PDATA,"^"),1,12) ;patient name
  1.  S $E(@STORE@(INS,TIEN,CIEN,PTIEN),14)=$P(PDATA,"^",2) ;primary long id 9 digit
  1.  S $E(@STORE@(INS,TIEN,CIEN,PTIEN),26)=$P(PDATA,"^",3) ;means test category
  1.  S $E(@STORE@(INS,TIEN,CIEN,PTIEN),31)=$P(PDATA,"^",4) ;primary eligibility
  1.  ;Removed by patch 174
  1.  ;S $E(@STORE@(INS,TIEN,CIEN,PTIEN),31)=$P(PDATA,"^",5) ;patient status
  1.  ;S $E(@STORE@(INS,TIEN,CIEN,PTIEN),35)=$P(PDATA,"^",6) ;status date
  1.  S $E(@STORE@(INS,TIEN,CIEN,PTIEN),42)=$P(PDATA,"^",7) ;last appointment
  1.  S $E(@STORE@(INS,TIEN,CIEN,PTIEN),54)=$P(PDATA,"^",8) ;next appointment
  1.  S $E(@STORE@(INS,TIEN,CIEN,PTIEN),66)=$E(CNAME,1,27) ;clinic name
  1.  S $E(@STORE@(INS,TIEN,CIEN,PTIEN),95)=$E($P(PDATA,U,9),1,18) ;PC prov.
  1.  S $E(@STORE@(INS,TIEN,CIEN,PTIEN),115)=$E($P(PDATA,U,10),1,18) ;Assoc. Prov.
  1.  Q
  1.  ;
  1. CHEAD(INS,TEAM,CLINIC) ;
  1.  ;column headings
  1.  ;
  1.  N EN,NEWP
  1.  W !
  1.  S NEWP=0
  1.  I IOST'?1"C-".E,$Y+5>(IOSL-6) D NEWP1^SCRPU3(.PAGE,TITL) S NEWP=1
  1.  I IOST?1"C-".E,$Y+5>(IOSL-6) D HOLD^SCRPU3(.PAGE,TITL) S NEWP=1
  1.  I STOP Q
  1.  I NEWP W !,$G(@STORE@(INS)),!!,$G(@STORE@(INS,TEAM)),!
  1. CH2 F EN="H0","H1","H2" W !,$G(@STORE@("SUBHEADER",EN))
  1.  Q
  1.  ;