[628] | 1 | SCRPTP3 ;ALB/CMM - List of Team's Patients ; 29 Jun 99 04:11PM
|
---|
| 2 | ;;5.3;Scheduling;**41,48,98,177,231,433,526,520**;AUG 13, 1993;Build 26
|
---|
| 3 | ;;DMR BP-OIFO Patch SD*5.3*526
|
---|
| 4 | ;
|
---|
| 5 | ;List of Team's Patients Report
|
---|
| 6 | ;
|
---|
| 7 | HITS(ARRY,TIEN) ;
|
---|
| 8 | ;ARRY - list of patients for a given team
|
---|
| 9 | ;TIEN - team ien
|
---|
| 10 | ;
|
---|
| 11 | N PTIEN,PIEN,PTNAME,PNAME,PTAI,NXT,NODE,CIEN,CNAME,INAME,INST,LAST,NEXT
|
---|
| 12 | N PAIEN,PC,PHONE,PNODE,PTPA,PTPAN,ROL,PID,TINFO,TNAME,TPIEN,TPNODE
|
---|
| 13 | N CNT,TPA,FLAG,DFN,VA,VAERR,PCAP,ROLN
|
---|
| 14 | S INACTIVE=0
|
---|
| 15 | S NXT=0
|
---|
| 16 | F S NXT=$O(@ARRY@(NXT)) Q:NXT=""!(NXT'?.N) D
|
---|
| 17 | .S NODE=$G(@ARRY@(NXT))
|
---|
| 18 | .Q:NODE=""
|
---|
| 19 | .S PTIEN=+$P(NODE,"^") ;patient ien
|
---|
| 20 | .S PTNAME=$P(NODE,"^",2) ;patient name
|
---|
| 21 | .S PTAI=+$P(NODE,"^",3) ;patient team assignment ien (#404.42)
|
---|
| 22 | .;
|
---|
| 23 | .S PNODE=$G(^DPT(PTIEN,0))
|
---|
| 24 | .Q:PNODE=""
|
---|
| 25 | .S DFN=PTIEN
|
---|
| 26 | .D PID^VADPT6
|
---|
| 27 | .;S PID=VA("BID")
|
---|
| 28 | .S PID=$E(VA("PID"),1,3)_$E(VA("PID"),5,6)_$E(VA("PID"),8,12)
|
---|
| 29 | .;
|
---|
| 30 | .N CNAME,PINF,CLIEN
|
---|
| 31 | .S CNT=""
|
---|
| 32 | .F S CNT=$O(^SCPT(404.43,"B",PTAI,CNT)) Q:CNT=""!(CNT'?.N) D
|
---|
| 33 | ..D TPAR(PTAI,CNT,.PINF,.CNAME,.CLIEN,.PNAME,.ROLN,.PCAP)
|
---|
| 34 | Q
|
---|
| 35 | ;
|
---|
| 36 | TPAR(PTAI,START,PINF,CNAME,CLIEN,PNAME,ROLN,PCAP) ;
|
---|
| 37 | N PTPA,TPIEN,TPNODE,ROL,CIEN,ENROLL,OKAY,NEXT,LAST,PAIEN
|
---|
| 38 | I '$D(^SCPT(404.43,"B",PTAI)) Q "0^[Not Assigned]"
|
---|
| 39 | ; ^ no patient team position assignment
|
---|
| 40 | IF START="" D
|
---|
| 41 | .S PTPA=$O(^SCPT(404.43,"B",PTAI,START))
|
---|
| 42 | ELSE D
|
---|
| 43 | .S PTPA=START
|
---|
| 44 | I PTPA="" Q "0^[Not Assigned]"
|
---|
| 45 | S PTPAN=$G(^SCPT(404.43,PTPA,0)) ;patient team assignment
|
---|
| 46 | I PTPAN=""!(PTPAN=0) Q "0^[Not Assigned]"
|
---|
| 47 | I $P(PTPAN,"^",4)'="",$P(PTPAN,"^",4)<DT Q -1
|
---|
| 48 | S TPIEN=+$P(PTPAN,"^",2) ;team position ien (#404.57)
|
---|
| 49 | I '$D(^SCTM(404.57,TPIEN,0)) Q "0^[Not Assigned]"
|
---|
| 50 | S TPNODE=$G(^SCTM(404.57,TPIEN,0))
|
---|
| 51 | I TPNODE="" Q "0^[Not Assigned]"
|
---|
| 52 | S ROL=+$P(TPNODE,"^",3) ;role for position (ien)
|
---|
| 53 | Q:'$D(ROLE(ROL))&(ROLE'=1) -1
|
---|
| 54 | ; ^ not a selected role
|
---|
| 55 | S ROLN=$P($G(^SD(403.46,ROL,0)),U) ;role name
|
---|
| 56 | ;
|
---|
| 57 | S PCAP=$S($P(PTPAN,U,5)<1:"NPC",+$$OKPREC3^SCMCLK(TPIEN,DT)>0:" AP",1:"PCP") ;PC?
|
---|
| 58 | ;
|
---|
| 59 | D SETASCL^SCRPRAC2(TPIEN,.CNAME,.CLIEN)
|
---|
| 60 | ;next two lines commented off - SD*5.3*433
|
---|
| 61 | ;S ENROLL=$$ENRL(PTIEN,CIEN) ;enrolled in associated clinic
|
---|
| 62 | ;I 'ENROLL S CNAME="",CIEN=0
|
---|
| 63 | ;
|
---|
| 64 | S PAIEN=$$CHK(TPIEN)
|
---|
| 65 | I +PAIEN'=0 S PIEN=+PAIEN,PNAME=$P(PAIEN,"^",2) ; practitioner's name
|
---|
| 66 | ;SD*5.3*231
|
---|
| 67 | I +PAIEN=0 S PIEN=0,PNAME="[Inactive Position]"
|
---|
| 68 | ;
|
---|
| 69 | D GETPINF^SCRPPAT2(PTIEN,.CLIEN,.PINF) ;get patient info
|
---|
| 70 | S CNAME=$G(CNAME(0))
|
---|
| 71 | S PINF=$G(PINF(0))
|
---|
| 72 | I PINF="" D
|
---|
| 73 | .S PINF=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CNAME,CNAME,1)
|
---|
| 74 | I INACTIVE S @STORE@(INS,TIEN,"INACT")=""
|
---|
| 75 | S FLAG="Y"
|
---|
| 76 | S TINFO=$$TINF^SCRPTP(TIEN) ;team information
|
---|
| 77 | S INST=+$P(TINFO,"^") ;institution ien
|
---|
| 78 | S INAME=$P($G(^DIC(4,INST,0)),"^") ;institution name
|
---|
| 79 | S PHONE=$P(TINFO,"^",4) ;team phone
|
---|
| 80 | S PC=$P(TINFO,"^",3) ;primary care?
|
---|
| 81 | S TNAME=$P(TINFO,"^",2) ;team name
|
---|
| 82 | D TFORMAT^SCRPTP2(INST,INAME,TIEN,TNAME,PHONE,PC)
|
---|
| 83 | D FORMAT^SCRPTP(INS,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,CNAME,PINF,ROLN,PCAP)
|
---|
| 84 | N SCCNT
|
---|
| 85 | S SCCNT=0 F S SCCNT=$O(CNAME(SCCNT)) Q:SCCNT="" D FORMATAC^SCRPTP(SCCNT,CNAME(SCCNT),PINF(SCCNT),INS,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,ROLN,PCAP)
|
---|
| 86 | Q
|
---|
| 87 | ;
|
---|
| 88 | ENRL(PTIEN,CLIEN) ;FUNCTIONALITY DISABLED
|
---|
| 89 | ;
|
---|
| 90 | ;N FOUND,ENODE,EN,NXT
|
---|
| 91 | ;S FOUND=0
|
---|
| 92 | ;Q:'$D(^DPT(PTIEN,"DE","B",CLIEN)) FOUND
|
---|
| 93 | ;S EN=$O(^DPT(PTIEN,"DE","B",CLIEN,""))
|
---|
| 94 | ;Q:EN=""!'$D(^DPT(PTIEN,"DE",EN,1)) FOUND
|
---|
| 95 | ;S NXT=""
|
---|
| 96 | ;F S NXT=$O(^DPT(PTIEN,"DE",EN,1,NXT)) Q:(FOUND)!(NXT="")!(NXT'?.N) D
|
---|
| 97 | ;check if active enrollment
|
---|
| 98 | ;S ENODE=$G(^DPT(PTIEN,"DE",EN,1,NXT,0))
|
---|
| 99 | ;I $P(ENODE,"^",3)'="",$P(ENODE,"^",3)<DT+1!$P(ENODE,"^")>DT Q ;not active enrollment
|
---|
| 100 | ;; ^ discharge date ^ enrollment date
|
---|
| 101 | S FOUND=0
|
---|
| 102 | Q FOUND
|
---|
| 103 | ;
|
---|
| 104 | CHK(TPIEN) ;assigned to a position
|
---|
| 105 | ;TPIEN - ien of 404.57 Team Position file
|
---|
| 106 | ;returns: ien of 200 New Person file
|
---|
| 107 | N EN,PLIST,PERR,ERR,NAME
|
---|
| 108 | S PLIST="PLST",PERR="PRR"
|
---|
| 109 | K @PLIST,@PERR
|
---|
| 110 | S ERR=$$PRTP^SCAPMC8(TPIEN,,.PLIST,.PERR)
|
---|
| 111 | I '$D(@PERR) D
|
---|
| 112 | .S EN=$P($G(@PLIST@(1)),"^") ;ien of new person file
|
---|
| 113 | .S NAME=$P($G(@PLIST@(1)),"^",2) ; new person name
|
---|
| 114 | K @PLIST,@PERR
|
---|
| 115 | Q EN_"^"_NAME
|
---|
| 116 | ;
|
---|