source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPTP.m@ 1423

SCRPTP ;ALB/CMM - List of Team's Patients ; 29 Jun 99  04:11PM
 ;;5.3;Scheduling;**41,48,174,177**;AUG 13, 1993
 ;
PROMPTS ;Prompt for Institution, Team, Role, Patient Status and Print device
 N QTIME,PRNT,VAUTD,VAUTT,VAUTR,VAUTPS,NUMBER
 K SCUP
 S QTIME=""
 W ! D INST^SCRPU1 I Y=-1 G ERR
 W ! K Y D PRMTT^SCRPU1 I '$D(VAUTT) G ERR
 W ! K Y D ROLE^SCRPU1 I '$D(VAUTR) G ERR
 W ! K Y D PTSTAT^SCRPU2 I '$D(VAUTPS) G ERR
 W ! K Y S SORT=$$SORT2^SCRPU2()
 I SORT<1 G ERR
 W !!,"This report requires 132 column output!"
 D QUE(.VAUTD,.VAUTT,.VAUTR,VAUTPS,SORT) Q
 ;
QUE(INST,TEAM,ROLE,PSTAT,SORT,IOP,ZTDTH) ;queue report
 ;INST - institutions selected (variable and array) 
 ;TEAM - teams selected (variable and array) 
 ;ROLE - roles selected (variable and array) 
 ;PSTAT - patient status - 1=all or OPT or AC 
 ;SORT - 1=d,t,ptname 2=d,t,last 4 Pt ID 3=d,t,pract,pt name 4=d,t,pract,last 4 Pt ID
 N ZTSAVE,II
 F II="INST","TEAM","ROLE","ROLE(","SORT","PSTAT","INST(","TEAM(" S ZTSAVE(II)=""
 W ! D EN^XUTMDEVQ("QENTRY^SCRPTP","Team Patient Listing",.ZTSAVE)
 Q
 ;
ENTRY2(INST,TEAM,ROLE,PSTAT,SORT,IOP,ZTDTH) ;Second entry point for GUI to use
 ;INST - institutions selected (variable and array)
 ;TEAM - teams selected (variable and array)
 ;ROLE - roles selected (variable and array)
 ;PSTAT - patient status - 1=all or OPT or AC
 ;SORT - 1=d,t,ptname 2=d,t,last 4 Pt ID 3=d,t,pract,pt name 4=d,t,pract,last 4 Pt ID
 ;IOP - print device
 ;ZTDTH - queue time (optional)
 ;
 ;validate parameters
 I '$D(INST)!'$D(TEAM)!'$D(ROLE)!'$D(PSTAT)!'$D(SORT)!'$D(IOP)!(IOP="") Q
 N NUMBER
 S IOST=$P(IOP,"^",2),IOP=$P(IOP,"^")
 I IOP?1"Q;".E S IOP=$P(IOP,"Q;",2)
 I IOST?1"C-".E D QENTRY G RET
 I ZTDTH="" S ZTDTH=$H
 S ZTRTN="QENTRY^SCRPTP"
 S ZTDESC="List of Team's Patients",ZTIO=IOP
 N II
 F II="INST","TEAM","ROLE","ROLE(","SORT","PSTAT","INST(","TEAM(","IOP" S ZTSAVE(II)=""
 D ^%ZTLOAD
RET S NUMBER=0
 I $D(ZTSK) S NUMBER=ZTSK
 D EXIT1
 Q NUMBER
 ;
QENTRY ;driver entry point
 S TITL="Team Patient Listing",STORE="^TMP("_$J_",""SCRPTP"")"
 K @STORE
 S @STORE=0
 D FIND
 I $O(@STORE@(0))="" S NODATA=$$NODATA^SCRPU3(TITL)
 I '$D(NODATA) D PRINTIT^SCRPTP2(STORE,TITL)
 D EXIT2
 Q
ERR ;
EXIT1 ;
 K ZTDTH,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE,SCUP
 Q
EXIT2 ;
 K @STORE
 K STOP,STORE,TITL,IOP,TEAM,INST,ROLE,PSTAT,SORT,NODATA
 Q
FIND ;
 N TIEN,ERR,LIST,OKAY
 I TEAM=1 D TALL^SCRPPAT3 ;gets all teams for all divisions selected
 S TIEN="",LIST="^TMP("_$J_",""SCRPTP ARRAY"")",ERR="ERROR"
 K @LIST,@ERR
 F  S TIEN=$O(TEAM(TIEN)) Q:TIEN=""  D
 .;TIEN - team ien
 .S OKAY=$$PTTM^SCAPMC2(TIEN,"",LIST,ERR)
 .; gets all patients for given team
 .D HITS^SCRPTP3(LIST,TIEN)
 .K @LIST,@ERR
 K @LIST,@ERR
 Q
TINF(TIEN) ;team information
 ;TIEN - team ien
 ;returns: institution ien ^ team name ^ primary care ^ team phone
 N PC,PHONE,TNODE,TNAME
 S TNODE=$G(^SCTM(404.51,TIEN,0))
 S TNAME=$P(TNODE,"^") ;team name
 S PC=$S($P(TNODE,"^",5)=1:"YES",1:"NO") ;primary care team
 S PHONE=$P(TNODE,"^",2) ;team phone
 S INS=+$P(TNODE,"^",7) ;institution ien
 D TDESC^SCRPITP2(TIEN,INS) ;gets team description
 Q INS_"^"_TNAME_"^"_PC_"^"_PHONE
 ;
PST(PTIEN,CLIEN) ;
 ;PTIEN - patient ien
 ;CLIEN - associated clinic ien
 ;returns 1=selected patient status, 0=not selected patient status
 ;
 N EN,NXT,FOUND,ENODE
 S EN="",(FOUND,NXT)=0
 Q:'$D(^DPT(PTIEN,"DE","B",CLIEN)) FOUND
 S EN=$O(^DPT(PTIEN,"DE","B",CLIEN,""))
 I EN=""&(PSTAT=1) S FOUND=1 Q FOUND
 Q:EN=""!'$D(^DPT(PTIEN,"DE",EN,1)) FOUND
 F  S NXT=$O(^DPT(PTIEN,"DE",EN,1,NXT)) Q:(FOUND)!(NXT="")!(NXT'?.N)  D
 .;check if active enrollment
 .S ENODE=$G(^DPT(PTIEN,"DE",EN,1,NXT,0))
 .I $P(ENODE,"^",3)'="",$P(ENODE,"^",3)<DT+1!$P(ENODE,"^")>DT Q  ;not active enrollment
 .;                      ^ discharge date     ^ enrollment date
 .Q:$P(ENODE,"^",2)'=$E(PSTAT,1)&(PSTAT'=1)  ;not selected patient status
 .S FOUND=1
 Q FOUND
 ;
FORMAT(INS,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,CNAME,LAST,NEXT,ROLN,PCAP) ;Format column information
 ;INS - Institution ien
 ;TIEN - team ien
 ;PTIEN - patient ien
 ;PTNAME - patient name
 ;PID - last 4 PID - includes pseudo notation as 5th
 ;PIEN - practitioner ien
 ;PNAME - practitioner name
 ;CNAME - clinic name
 ;LAST - last appointment
 ;NEXT - next appointment
 ;ROLN - role name
 ;PCAP - PC?
 ;
 N SEC,TRD
 I PNAME="" S PNAME="[BAD DATA]"
 I PTNAME="" S PTNAME="[BAD DATA]"
 I PID="" S PID="****"
 S @STORE@("P",INS,TIEN,PNAME,PIEN)="" ;practitioner
 S @STORE@("PT",INS,TIEN,PTNAME,PTIEN)="" ;patient
 S @STORE@("PID",INS,TIEN,PID,PTIEN)="" ;last 4 pid
 N TRD
 I (SORT=1)!(SORT=2) S SEC=PTIEN,TRD=PIEN ;sort doesn't include practitioner
 I (SORT=3)!(SORT=4) S SEC=PIEN,TRD=PTIEN ;sort includes practitioner
 S @STORE@(INS,TIEN,SEC,TRD)=$E(PTNAME,1,22) ;patient name
 S $E(@STORE@(INS,TIEN,SEC,TRD),25)=PID ;last 4 pid
 S $E(@STORE@(INS,TIEN,SEC,TRD),32)=$E(PNAME,1,22) ;practitioner name
 S $E(@STORE@(INS,TIEN,SEC,TRD),56)=$E($G(ROLN),1,22) ;role name
 S $E(@STORE@(INS,TIEN,SEC,TRD),80)=$G(PCAP) ;PC?
 S $E(@STORE@(INS,TIEN,SEC,TRD),85)=LAST ;last appointment
 S $E(@STORE@(INS,TIEN,SEC,TRD),97)=NEXT ;next appointment
 S $E(@STORE@(INS,TIEN,SEC,TRD),109)=$E(CNAME,1,24) ;clinic name
 Q