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

SCRPTA2.m

Go to the documentation of this file.
  1. SCRPTA2 ;ALB/CMM - Patient Listing w/Team Assignment Data ; 30 Jun 99 1:33 PM
  1. ;;5.3;Scheduling;**41,88,140,148,174,181,177,526**;AUG 13, 1993;Build 8
  1. ;
  1. ;Patient Listing w/Team Assignment Data Report continued
  1. ;
  1. CHK(PTIEN,PIEN) ;assigned to a position
  1. ;PTIEN - ien of 404.42 Patient Team Assignment file
  1. ;PIEN - ien of patient file #2
  1. ;
  1. N NODE,START,TPIEN,TPNODE,ROL,PRAC,ROLN,PCAP,PRCN
  1. S START=""
  1. Q:'$D(^SCPT(404.43,"B",PTIEN))&(PRACT'="")
  1. I '$D(^SCPT(404.43,"B",PTIEN))&(PRACT="") D NOTA(PTIEN,PIEN) Q
  1. F S START=$O(^SCPT(404.43,"B",PTIEN,START)) Q:START="" D
  1. .S NODE=$G(^SCPT(404.43,START,0))
  1. .Q:NODE=""
  1. .Q:($P(NODE,"^",4)'="")&($P(NODE,"^",4)<DT)
  1. .; ^ not assigned currently
  1. .S PCAP=+$P(NODE,U,5)
  1. .S TPIEN=+$P(NODE,"^",2) ;team position ien (404.57)
  1. .I '$D(^SCTM(404.57,TPIEN,0)) D NOTA(PTIEN,PIEN) Q
  1. .S TPNODE=$G(^SCTM(404.57,TPIEN,0))
  1. .I TPNODE="" D NOTA(PTIEN,PIEN) Q
  1. .S PCAP=$S('PCAP:"NPC",+$$OKPREC3^SCMCLK(TPIEN,DT)>0:" AP",1:"PCP") ; PC?
  1. .S PRCN=$P($$OKPREC2^SCMCLK(TPIEN,DT),U,2) ;preceptor name
  1. .;
  1. .S ROL=+$P(TPNODE,"^",3) ;role for position (ien)
  1. .Q:'$D(ROLE(ROL))&(ROLE'=1) ;not a selected role
  1. .S ROLN=$P($G(^SD(403.46,ROL,0)),U) ;role name
  1. .;
  1. .S PRAC=$$PRACI(TPIEN) ;practitioner information
  1. .I +PRAC=-1 D NOTA(PTIEN,PIEN) Q
  1. .I (PRACT'=1)&('$D(PRACT(+PRAC)))&(+PRAC'=0) Q
  1. .; ^ not a selected practitioner
  1. .;
  1. .S POS=$P($G(^SCTM(404.57,TPIEN,0)),"^")
  1. .D FOUND2(START,NODE,TPIEN,POS,TPNODE,PRAC,PIEN,ROLN,PCAP,PRCN)
  1. Q
  1. PRACI(TPIEN) ;
  1. ;TPIEN - team position ien (404.57)
  1. ;
  1. N EN,TPLIST,TPERR,NAME,POS,ERR,NPIEN,NODE,POSIEN
  1. S TPLIST="TPLST",TPERR="ERR2"
  1. K @TPLIST,@TPERR
  1. S ERR=$$PRTP^SCAPMC8(TPIEN,,.TPLIST,.TPERR)
  1. Q:ERR=0!($D(@TPERR)) -1
  1. S NODE=$G(@TPLIST@(1))
  1. Q:NODE="" "0^[Not Assigned]"
  1. S NAME=$P(NODE,"^",2) ;practitioner name
  1. S NPIEN=+$P(NODE,"^") ;practitioner ien
  1. S POS=$P(NODE,"^",4) ;position name
  1. S POSIEN=+$P(NODE,"^",3) ;position ien
  1. I POS="" S POS="[Not Assigned]",POSIEN=0
  1. I NAME="" S NAME="[Not Assigned]",NPIEN=0
  1. K @TPLIST,@TPERR
  1. Q NPIEN_"^"_NAME_"^"_POS_"^"_POSIEN
  1. ;
  1. FOUND2(START,NODE,TPIEN,POS,TPNODE,PRAC,PIEN,ROLN,PCAP,PRCN) ;
  1. ;START - patient team assignment position ien
  1. ;NODE - patient team position assignment node
  1. ;TPIEN - team position ien (404.57)
  1. ;POS - team position
  1. ;TPNODE - team position node (404.57)
  1. ;PRAC - practitioner info. NAME IEN^NAME^POS^POSIEN
  1. ;ROLN - role name
  1. ;PCAP - PC/AP/NPC assignment?
  1. ;PRCN - preceptor name
  1. ;
  1. N PTNAME,PID,ADATE
  1. S PTNAME=$P($G(^DPT(PIEN,0)),"^") ;patient name
  1. S PID=$P($G(^DPT(PIEN,.36)),"^",3),PID=$TR(PID,"-","")
  1. ;9 digit ssn SD*5.3*526 - dmr
  1. ;S PID=$E(PID,6,10) ;last four pid include 5th for pseudo notation
  1. ;
  1. S ADATE=$P(NODE,"^",3) ;position assignment date - fm format
  1. ;convert to external format
  1. I ADATE'="" S ADATE=$TR($$FMTE^XLFDT(ADATE,"5DF")," ","0")
  1. ;
  1. S PNAME=$P(PRAC,"^",2) ;practitioner name
  1. S PNIEN=$P(PRAC,"^") ;practitioner ien
  1. ;
  1. S TIEN=+$P(TPNODE,"^",2) ;ien team file 404.51
  1. S TMN=$G(^SCTM(404.51,TIEN,0))
  1. Q:TMN=""
  1. S TNAME=$P(TMN,"^") ;team name
  1. S PC=$P(TMN,"^",5) ;primary care team 1/0
  1. S IIEN=+$P(TMN,"^",7) ;institution ien
  1. S INAME=$P($G(^DIC(4,IIEN,0)),"^") ;institution
  1. ;
  1. D FORMAT(IIEN,INAME,TNAME,TIEN,PC,PTNAME,PID,PNAME,PNIEN,POS,TPIEN,ADATE,PIEN,ROLN,PCAP,PRCN)
  1. Q
  1. ;
  1. FORMAT(IIEN,INAME,TNAME,TIEN,PC,PTNAME,PID,PNAME,PIEN,POS,TPIEN,ADATE,PTIEN,ROLN,PCAP,PRCN) ;
  1. ;IIEN - institution ien
  1. ;INAME - institution name
  1. ;TNAME - team name
  1. ;TIEN - team ien
  1. ;PC - primary care 1/0
  1. ;PTNAME - patient name
  1. ;PID - last 4 pid plus 5th pseudo
  1. ;PNAME - practitioner name
  1. ;PIEN - practitioner ien
  1. ;POS - position name
  1. ;TPIEN - position ien
  1. ;ADATE - assignment date
  1. ;PTIEN - patient ien
  1. ;ROLN - role name
  1. ;PCAP - PC/AP/NPC assignment?
  1. ;PRCN - preceptor name
  1. ;
  1. I INAME="" S INAME="[BAD DATA]"
  1. I TNAME="" S TNAME="[BAD DATA]"
  1. I PNAME="" S PNAME="[BAD DATA]"
  1. I '$D(@STORE@("I",INAME,IIEN)) S @STORE@("I",INAME,IIEN)=""
  1. I '$D(@STORE@("T",IIEN,TNAME,TIEN)) S @STORE@("T",IIEN,TNAME,TIEN)=""
  1. I '$D(@STORE@("P",IIEN,TIEN,PNAME,PIEN,TPIEN)) S @STORE@("P",IIEN,TIEN,PNAME,PIEN,TPIEN)=""
  1. S @STORE@(IIEN)="Division: "_INAME
  1. S @STORE@(IIEN,TIEN)="Team: "_TNAME
  1. S $E(@STORE@(IIEN,TIEN),40)="Primary Care Team: "_$S(PC=1:"YES",1:"NO")
  1. ;
  1. S @STORE@(IIEN,TIEN,PIEN,TPIEN,PTNAME,PTIEN)=$E(PTNAME,1,17)
  1. S $E(@STORE@(IIEN,TIEN,PIEN,TPIEN,PTNAME,PTIEN),19)=PID
  1. S $E(@STORE@(IIEN,TIEN,PIEN,TPIEN,PTNAME,PTIEN),31)=ADATE
  1. S $E(@STORE@(IIEN,TIEN,PIEN,TPIEN,PTNAME,PTIEN),43)=PCAP
  1. S $E(@STORE@(IIEN,TIEN,PIEN,TPIEN,PTNAME,PTIEN),49)=$E(PNAME,1,21)
  1. S $E(@STORE@(IIEN,TIEN,PIEN,TPIEN,PTNAME,PTIEN),70)=$E(POS,1,20)
  1. S $E(@STORE@(IIEN,TIEN,PIEN,TPIEN,PTNAME,PTIEN),92)=$E(ROLN,1,20)
  1. S $E(@STORE@(IIEN,TIEN,PIEN,TPIEN,PTNAME,PTIEN),113)=$E(PRCN,1,20)
  1. Q
  1. ;
  1. NOTA(PTIEN,PIEN) ;
  1. ;PTIEN - patient team assignment (#404.42)
  1. ;PIEN - patient ien
  1. N IIEN,INAME,TNAME,TIEN,PC,PTNAME,PID,PNAME,PNIEN,POSIEN,POS,TPIEN
  1. N ROLN,PCAP,PRCN,ADATE
  1. S POS="[Not Assigned]",POSIEN=0
  1. S PNAME="[Not Assigned]",PNIEN=0
  1. S (ROLN,PCAP,PRCN,ADATE)=""
  1. ;
  1. S PTNAME=$E($P($G(^DPT(PIEN,0)),"^"),1,20) ;patient name
  1. S PID=$P($G(^DPT(PIEN,.36)),"^",3),PID=$TR(PID,"-","")
  1. ;S PID=$E(PID,6,10) ;9 digit ssn patch 526
  1. ;
  1. S TIEN=+$P($G(^SCPT(404.42,PTIEN,0)),"^",3) ;team ien
  1. S TMN=$G(^SCTM(404.51,TIEN,0))
  1. Q:TMN=""
  1. S TNAME=$P(TMN,"^") ;team name
  1. S PC=$P(TMN,"^",5) ;primary care team 1/0
  1. S IIEN=+$P(TMN,"^",7) ;institution ien
  1. S INAME=$P($G(^DIC(4,IIEN,0)),"^") ;institution name
  1. ;
  1. D FORMAT(IIEN,INAME,TNAME,TIEN,PC,PTNAME,PID,PNAME,PNIEN,POS,POSIEN,ADATE,PIEN,ROLN,PCAP,PRCN)
  1. Q