[613] | 1 | SCRPV1A ; bp/djb - PCMM Inconsistency Rpt - Get Data ; 8/25/99 9:57am
|
---|
| 2 | ;;5.3;Scheduling;**177**;AUG 13, 1993
|
---|
| 3 | ;
|
---|
| 4 | ;Return:
|
---|
| 5 | ; Inconsistency array in format:
|
---|
| 6 | ; ^TMP("PCMM POSITION",$J,#,Tm,TmPos,)=""
|
---|
| 7 | ; ^TMP("PCMM PATIENT",$J,Name,DFN,#,Tm,Pos)=""
|
---|
| 8 | ;
|
---|
| 9 | ;For a list of inconsistencies, see bottom of routine SCRPV1B.
|
---|
| 10 | ;
|
---|
| 11 | EN ;
|
---|
| 12 | D POSITION
|
---|
| 13 | D PATIENT
|
---|
| 14 | Q
|
---|
| 15 | ;
|
---|
| 16 | POSITION ;Check for position inconsistencies.
|
---|
| 17 | ;
|
---|
| 18 | NEW POSI,POSN,TMI,TMN
|
---|
| 19 | ;
|
---|
| 20 | ;Look at each team
|
---|
| 21 | S TMN=""
|
---|
| 22 | F S TMN=$O(^SCTM(404.51,"B",TMN)) Q:TMN="" D ;
|
---|
| 23 | . S TMI=0
|
---|
| 24 | . F S TMI=$O(^SCTM(404.51,"B",TMN,TMI)) Q:'TMI D ;
|
---|
| 25 | .. Q:'$D(^SCTM(404.51,TMI,0))
|
---|
| 26 | .. ;If user selected teams, quit if this one isn't on list.
|
---|
| 27 | .. I SCTYPE("TM")="S" Q:'$D(SCTM(TMI))
|
---|
| 28 | .. ;Look at each position for this team
|
---|
| 29 | .. S POSI=0
|
---|
| 30 | .. F S POSI=$O(^SCTM(404.57,"C",TMI,POSI)) Q:'POSI D ;
|
---|
| 31 | ... S POSN=$P($G(^SCTM(404.57,POSI,0)),U,1) Q:POSN']""
|
---|
| 32 | ... D CHECK45(TMI,POSI) ;..Check for inconsistencies 4 & 5.
|
---|
| 33 | ... Q:'$D(^SCPT(404.43,"APTPA",POSI))
|
---|
| 34 | ... D CHECK1(TMI,POSI) ;...Check for inconsistency 1.
|
---|
| 35 | Q
|
---|
| 36 | ;
|
---|
| 37 | PATIENT ;Check for patient inconsistencies.
|
---|
| 38 | D CHECK28
|
---|
| 39 | D CHECK367
|
---|
| 40 | Q
|
---|
| 41 | ;
|
---|
| 42 | CHECK1(TMI,POSI) ;Check positions for inconsistency 1.
|
---|
| 43 | ;Input:
|
---|
| 44 | ; TMI - Team IEN
|
---|
| 45 | ; POSI - Team Position IEN
|
---|
| 46 | ;
|
---|
| 47 | NEW POSN,TMN
|
---|
| 48 | Q:+$$GETPRTP^SCAPMCU2(POSI,DT) ;Current provider. Fld 304 in 404.57.
|
---|
| 49 | Q:+$$ACTTM^SCMCTMU(TMI,DT)'=1 ;Team inactive
|
---|
| 50 | Q:+$$ACTTP^SCMCTPU(POSI,DT)'=1 ;Position inactive
|
---|
| 51 | S TMN=$$TMNAME(TMI)
|
---|
| 52 | S POSN=$$POSNAME(POSI)
|
---|
| 53 | S ^TMP("PCMM POSITION",$J,1,TMN,POSN)="" ;.........................#1
|
---|
| 54 | Q
|
---|
| 55 | ;
|
---|
| 56 | CHECK28 ;Check patients for inconsistencies 2 & 8.
|
---|
| 57 | ;
|
---|
| 58 | ;Loop thru 404.43 for each patient.
|
---|
| 59 | ;Use "ACTDFN" xref. Active entries sorted by patient IEN.
|
---|
| 60 | ;
|
---|
| 61 | NEW DATA,DFN,DFNNAM,NUM,POSI,POSN,PTI,PTPI,TMI,TMN
|
---|
| 62 | ;
|
---|
| 63 | S DFN=0
|
---|
| 64 | F S DFN=$O(^SCPT(404.43,"ACTDFN",DFN)) Q:'DFN D ;
|
---|
| 65 | . S PTPI=0
|
---|
| 66 | . F S PTPI=$O(^SCPT(404.43,"ACTDFN",DFN,PTPI)) Q:'PTPI D ;
|
---|
| 67 | .. S DATA=$G(^SCPT(404.43,PTPI,0)) ;Team Position Assign zero node
|
---|
| 68 | .. Q:$P(DATA,U,4)]"" ;.............Inactive
|
---|
| 69 | .. S PTI=$P(DATA,U,1) Q:'PTI ;.....Team Assign IEN
|
---|
| 70 | .. S POSI=$P(DATA,U,2) Q:'POSI ;...Position
|
---|
| 71 | .. S DATA=$G(^SCPT(404.42,PTI,0)) ;.Team Assign zero node
|
---|
| 72 | .. S TMI=$P(DATA,U,3) Q:'TMI ;.....Team IEN
|
---|
| 73 | .. ;
|
---|
| 74 | .. ;If user selected teams, quit if this one isn't on list.
|
---|
| 75 | .. I SCTYPE("TM")="S" Q:'$D(SCTM(TMI))
|
---|
| 76 | .. ;
|
---|
| 77 | .. S POSN=$$POSNAME(POSI)
|
---|
| 78 | .. S TMN=$$TMNAME(TMI)
|
---|
| 79 | .. S DFNNAM=$$PTNAME(DFN) ;Patient name
|
---|
| 80 | .. ;
|
---|
| 81 | .. D ;Check for nconsistency 8
|
---|
| 82 | ... I $P(DATA,U,9)]"" D ;...............Tm Pos Assign Inactive....#8
|
---|
| 83 | .... S ^TMP("PCMM PATIENT",$J,DFNNAM,DFN,8.1,TMN,POSN)=PTPI
|
---|
| 84 | ... I +$$ACTTM^SCMCTMU(TMI,DT)'=1 D ;...Team inactive.............#8
|
---|
| 85 | .... S ^TMP("PCMM PATIENT",$J,DFNNAM,DFN,8.2,TMN,POSN)=PTPI
|
---|
| 86 | ... I +$$ACTTP^SCMCTPU(POSI,DT)'=1 D ;..Position inactive.........#8
|
---|
| 87 | .... S ^TMP("PCMM PATIENT",$J,DFNNAM,DFN,8.3,TMN,POSN)=PTPI
|
---|
| 88 | .. ;
|
---|
| 89 | .. Q:$P(DATA,U,8)'=1 ;..Team Assign not PC
|
---|
| 90 | .. Q:$P(DATA,U,9)]"" ;..Team Assign inactive
|
---|
| 91 | .. ;
|
---|
| 92 | .. Q:$D(^SCPT(404.43,"APCPOS",DFN,1))
|
---|
| 93 | .. S ^TMP("PCMM PATIENT",$J,DFNNAM,DFN,2,TMN,POSN)=PTPI ;..........#2
|
---|
| 94 | Q
|
---|
| 95 | ;
|
---|
| 96 | CHECK367 ;Check patients for inconsistencies 3,6,7.
|
---|
| 97 | ;
|
---|
| 98 | ;Loop thru 404.43 for each patient.
|
---|
| 99 | ;Use "ACTPC" xref. Active entries sorted by patient IEN & PC ROLE.
|
---|
| 100 | ;
|
---|
| 101 | NEW CNT,DATA,DFN,DFNNAM,HLD,POSI,POSN,PTI,PTPI,TMI,TMN
|
---|
| 102 | ;
|
---|
| 103 | S DFN=0
|
---|
| 104 | F S DFN=$O(^SCPT(404.43,"ACTPC",DFN)) Q:'DFN D ;
|
---|
| 105 | . S CNT=0 KILL HLD ;Initialize for each DFN
|
---|
| 106 | . S PTPI=0
|
---|
| 107 | . F S PTPI=$O(^SCPT(404.43,"ACTPC",DFN,1,PTPI)) Q:'PTPI D ;
|
---|
| 108 | .. S DATA=$G(^SCPT(404.43,PTPI,0)) ;..Team Position Assign zero node
|
---|
| 109 | .. Q:$P(DATA,U,4)]"" ;...............Inactive
|
---|
| 110 | .. S PTI=$P(DATA,U,1) Q:'PTI ;.......Team Assign IEN
|
---|
| 111 | .. S POSI=$P(DATA,U,2) Q:'POSI ;.....Position
|
---|
| 112 | .. S DATA=$G(^SCPT(404.42,PTI,0)) ;...Team Assign zero node
|
---|
| 113 | .. S TMI=$P(DATA,U,3) Q:'TMI ;.......Team IEN
|
---|
| 114 | .. ;
|
---|
| 115 | .. ;If user selected teams, quit if this one isn't on list.
|
---|
| 116 | .. I SCTYPE("TM")="S" Q:'$D(SCTM(TMI))
|
---|
| 117 | .. ;
|
---|
| 118 | .. Q:$P(DATA,U,8)'=1 ;...............Team Assign not PC
|
---|
| 119 | .. Q:$P(DATA,U,9)]"" ;...............Team Assign inactive
|
---|
| 120 | .. S POSN=$$POSNAME(POSI)
|
---|
| 121 | .. S TMN=$$TMNAME(TMI)
|
---|
| 122 | .. S DFNNAM=$$PTNAME(DFN) ;Patient name
|
---|
| 123 | .. ;
|
---|
| 124 | .. D CHECK67
|
---|
| 125 | .. ;
|
---|
| 126 | .. S CNT=CNT+1
|
---|
| 127 | .. ;Save 1st occurance. Asingle occurance is not a problem.
|
---|
| 128 | .. I CNT=1 S HLD(DFNNAM,DFN,3,TMN,POSN)="" Q
|
---|
| 129 | .. ;
|
---|
| 130 | .. ;If there is a 2nd occurance, move 1st occurance into array.
|
---|
| 131 | .. I CNT=2 M ^TMP("PCMM PATIENT",$J)=HLD KILL HLD
|
---|
| 132 | .. S ^TMP("PCMM PATIENT",$J,DFNNAM,DFN,3,TMN,POSN)=PTPI ;..........#3
|
---|
| 133 | Q
|
---|
| 134 | ;
|
---|
| 135 | CHECK45(TMI,POSI) ;Check positions for inconsistencies 4 & 5.
|
---|
| 136 | ;Input:
|
---|
| 137 | ; TMI - Team IEN
|
---|
| 138 | ; POSI - Team Position IEN
|
---|
| 139 | ;
|
---|
| 140 | NEW AP,DATA,PCP,POSN,PREHI,STAFFAP,STAFFPCP,TMN
|
---|
| 141 | ;
|
---|
| 142 | S PREHI=0
|
---|
| 143 | F S PREHI=$O(^SCTM(404.53,"B",POSI,PREHI)) Q:'PREHI D ;
|
---|
| 144 | . S DATA=$G(^SCTM(404.53,PREHI,0))
|
---|
| 145 | . Q:DATA']""
|
---|
| 146 | . S AP=$P(DATA,U,1) ;.....................Preceptee position
|
---|
| 147 | . S PCP=$P(DATA,U,6) ;....................Preceptor position
|
---|
| 148 | . S STAFFAP=+$$GETPRTP^SCAPMCU2(AP,DT) ;..Preceptee staff person
|
---|
| 149 | . S STAFFPCP=+$$GETPRTP^SCAPMCU2(PCP,DT) ;Preceptor staff person
|
---|
| 150 | . ;
|
---|
| 151 | . S TMN=$$TMNAME(TMI)
|
---|
| 152 | . S POSN=$$POSNAME(POSI)
|
---|
| 153 | . I STAFFAP,STAFFAP=STAFFPCP D ;
|
---|
| 154 | .. S ^TMP("PCMM POSITION",$J,4,TMN,POSN)="" ;......................#4
|
---|
| 155 | . I STAFFPCP="" D ;
|
---|
| 156 | .. S ^TMP("PCMM POSITION",$J,5,TMN,POSN)="" ;......................#5
|
---|
| 157 | Q
|
---|
| 158 | ;
|
---|
| 159 | CHECK67 ;Check patients for inconsistencies 6 & 7.
|
---|
| 160 | NEW ERROR,ID,LIST,NUM,POS,RESULT,TYPE,ZDATE
|
---|
| 161 | ;
|
---|
| 162 | S ZDATE("BEGIN")=DT
|
---|
| 163 | S ZDATE("END")=DT
|
---|
| 164 | S ZDATE("INCL")=0
|
---|
| 165 | ;
|
---|
| 166 | S RESULT=$$PRPTTPC^SCAPMC(PTPI,"ZDATE","LIST","ERROR",1)
|
---|
| 167 | ;
|
---|
| 168 | S NUM=0
|
---|
| 169 | F S NUM=$O(LIST(NUM)) Q:'NUM D ;
|
---|
| 170 | . S TYPE=""
|
---|
| 171 | . F S TYPE=$O(LIST(NUM,TYPE)) Q:TYPE="" D ;
|
---|
| 172 | .. S ID=""
|
---|
| 173 | .. F S ID=$O(LIST(NUM,TYPE,ID)) Q:ID="" D ;
|
---|
| 174 | ... S POS=$P(LIST(NUM,TYPE,ID),U,3) Q:'POS
|
---|
| 175 | ... ;See if field 4, POSSIBLE PRIMARY PRACTITIONER, equals 1.
|
---|
| 176 | ... Q:$P($G(^SCTM(404.57,POS,0)),U,4)=1
|
---|
| 177 | ... I TYPE="AP" D Q
|
---|
| 178 | .... S ^TMP("PCMM PATIENT",$J,DFNNAM,DFN,6,TMN,POSN)=PTPI ;........#6
|
---|
| 179 | ... I TYPE="PCP" D Q
|
---|
| 180 | .... S ^TMP("PCMM PATIENT",$J,DFNNAM,DFN,7,TMN,POSN)=PTPI ;........#7
|
---|
| 181 | Q
|
---|
| 182 | ;
|
---|
| 183 | TMNAME(TMI) ;Return team name
|
---|
| 184 | NEW NAME
|
---|
| 185 | S NAME=$P($G(^SCTM(404.51,TMI,0)),U,1)
|
---|
| 186 | S:NAME="" NAME="UNKNOWN"
|
---|
| 187 | Q NAME
|
---|
| 188 | ;
|
---|
| 189 | POSNAME(POSI) ;Return position name
|
---|
| 190 | NEW NAME
|
---|
| 191 | S NAME=$P($G(^SCTM(404.57,POSI,0)),U,1)
|
---|
| 192 | S:NAME="" NAME="UNKNOWN"
|
---|
| 193 | Q NAME
|
---|
| 194 | ;
|
---|
| 195 | PTNAME(DFN) ;Return patient name
|
---|
| 196 | NEW NAME
|
---|
| 197 | S NAME=$P($G(^DPT(DFN,0)),U,1)
|
---|
| 198 | S:NAME="" NAME="UNKNOWN"
|
---|
| 199 | Q NAME
|
---|