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

SCRPV1A.m

Go to the documentation of this file.
  1. SCRPV1A ; bp/djb - PCMM Inconsistency Rpt - Get Data ; 8/25/99 9:57am
  1. ;;5.3;Scheduling;**177,528**;AUG 13, 1993;Build 4
  1. ;
  1. ;Return:
  1. ; Inconsistency array in format:
  1. ; ^TMP("PCMM POSITION",$J,#,Tm,TmPos,)=""
  1. ; ^TMP("PCMM PATIENT",$J,Name,DFN,#,Tm,Pos)=""
  1. ;
  1. ;For a list of inconsistencies, see bottom of routine SCRPV1B.
  1. ;
  1. EN ;
  1. D POSITION
  1. D PATIENT
  1. Q
  1. ;
  1. POSITION ;Check for position inconsistencies.
  1. ;
  1. NEW POSI,POSN,TMI,TMN
  1. ;
  1. ;Look at each team
  1. S TMN=""
  1. F S TMN=$O(^SCTM(404.51,"B",TMN)) Q:TMN="" D ;
  1. . S TMI=0
  1. . F S TMI=$O(^SCTM(404.51,"B",TMN,TMI)) Q:'TMI D ;
  1. .. Q:'$D(^SCTM(404.51,TMI,0))
  1. .. ;If user selected teams, quit if this one isn't on list.
  1. .. I SCTYPE("TM")="S" Q:'$D(SCTM(TMI))
  1. .. ;Look at each position for this team
  1. .. S POSI=0
  1. .. F S POSI=$O(^SCTM(404.57,"C",TMI,POSI)) Q:'POSI D ;
  1. ... S POSN=$P($G(^SCTM(404.57,POSI,0)),U,1) Q:POSN']""
  1. ... D CHECK45(TMI,POSI) ;..Check for inconsistencies 4 & 5.
  1. ... Q:'$D(^SCPT(404.43,"APTPA",POSI))
  1. ... D CHECK1(TMI,POSI) ;...Check for inconsistency 1.
  1. Q
  1. ;
  1. PATIENT ;Check for patient inconsistencies.
  1. D CHECK28
  1. D CHECK367
  1. Q
  1. ;
  1. CHECK1(TMI,POSI) ;Check positions for inconsistency 1.
  1. ;Input:
  1. ; TMI - Team IEN
  1. ; POSI - Team Position IEN
  1. ;
  1. NEW POSN,TMN
  1. Q:+$$GETPRTP^SCAPMCU2(POSI,DT) ;Current provider. Fld 304 in 404.57.
  1. Q:+$$ACTTM^SCMCTMU(TMI,DT)'=1 ;Team inactive
  1. Q:+$$ACTTP^SCMCTPU(POSI,DT)'=1 ;Position inactive
  1. S TMN=$$TMNAME(TMI)
  1. S POSN=$$POSNAME(POSI)
  1. S ^TMP("PCMM POSITION",$J,1,TMN,POSN)="" ;.........................#1
  1. Q
  1. ;
  1. CHECK28 ;Check patients for inconsistencies 2 & 8.
  1. ;
  1. ;Loop thru 404.43 for each patient.
  1. ;Use "ACTDFN" xref. Active entries sorted by patient IEN.
  1. ;
  1. NEW DATA,DFN,DFNNAM,NUM,POSI,POSN,PTI,PTPI,TMI,TMN
  1. ;
  1. S DFN=0
  1. F S DFN=$O(^SCPT(404.43,"ACTDFN",DFN)) Q:'DFN D ;
  1. . S PTPI=0
  1. . F S PTPI=$O(^SCPT(404.43,"ACTDFN",DFN,PTPI)) Q:'PTPI D ;
  1. .. S DATA=$G(^SCPT(404.43,PTPI,0)) ;Team Position Assign zero node
  1. .. Q:$P(DATA,U,4)]"" ;.............Inactive
  1. .. S PTI=$P(DATA,U,1) Q:'PTI ;.....Team Assign IEN
  1. .. S POSI=$P(DATA,U,2) Q:'POSI ;...Position
  1. .. S DATA=$G(^SCPT(404.42,PTI,0)) ;.Team Assign zero node
  1. .. S TMI=$P(DATA,U,3) Q:'TMI ;.....Team IEN
  1. .. ;
  1. .. ;If user selected teams, quit if this one isn't on list.
  1. .. I SCTYPE("TM")="S" Q:'$D(SCTM(TMI))
  1. .. ;
  1. .. S POSN=$$POSNAME(POSI)
  1. .. S TMN=$$TMNAME(TMI)
  1. .. S DFNNAM=$$PTNAME(DFN) ;Patient name
  1. .. ;
  1. .. D ;Check for nconsistency 8
  1. ... I $P(DATA,U,9)]"" D ;...............Tm Pos Assign Inactive....#8
  1. .... S ^TMP("PCMM PATIENT",$J,DFNNAM,DFN,8.1,TMN,POSN)=PTPI
  1. ... I +$$ACTTM^SCMCTMU(TMI,DT)'=1 D ;...Team inactive.............#8
  1. .... S ^TMP("PCMM PATIENT",$J,DFNNAM,DFN,8.2,TMN,POSN)=PTPI
  1. ... I +$$ACTTP^SCMCTPU(POSI,DT)'=1 D ;..Position inactive.........#8
  1. .... S ^TMP("PCMM PATIENT",$J,DFNNAM,DFN,8.3,TMN,POSN)=PTPI
  1. .. ;
  1. .. Q:$P(DATA,U,8)'=1 ;..Team Assign not PC
  1. .. Q:$P(DATA,U,9)]"" ;..Team Assign inactive
  1. .. ;
  1. .. ;Q:$D(^SCPT(404.43,"APCPOS",DFN,1))
  1. .. I $$GETPRTP^SCAPMCU2(POSI,DT)>0 Q ;sd/528
  1. .. S ^TMP("PCMM PATIENT",$J,DFNNAM,DFN,2,TMN,POSN)=PTPI ;..........#2
  1. Q
  1. ;
  1. CHECK367 ;Check patients for inconsistencies 3,6,7.
  1. ;
  1. ;Loop thru 404.43 for each patient.
  1. ;Use "ACTPC" xref. Active entries sorted by patient IEN & PC ROLE.
  1. ;
  1. NEW CNT,DATA,DFN,DFNNAM,HLD,POSI,POSN,PTI,PTPI,TMI,TMN
  1. ;
  1. S DFN=0
  1. F S DFN=$O(^SCPT(404.43,"ACTPC",DFN)) Q:'DFN D ;
  1. . S CNT=0 KILL HLD ;Initialize for each DFN
  1. . S PTPI=0
  1. . F S PTPI=$O(^SCPT(404.43,"ACTPC",DFN,1,PTPI)) Q:'PTPI D ;
  1. .. S DATA=$G(^SCPT(404.43,PTPI,0)) ;..Team Position Assign zero node
  1. .. Q:$P(DATA,U,4)]"" ;...............Inactive
  1. .. S PTI=$P(DATA,U,1) Q:'PTI ;.......Team Assign IEN
  1. .. S POSI=$P(DATA,U,2) Q:'POSI ;.....Position
  1. .. S DATA=$G(^SCPT(404.42,PTI,0)) ;...Team Assign zero node
  1. .. S TMI=$P(DATA,U,3) Q:'TMI ;.......Team IEN
  1. .. ;
  1. .. ;If user selected teams, quit if this one isn't on list.
  1. .. I SCTYPE("TM")="S" Q:'$D(SCTM(TMI))
  1. .. ;
  1. .. Q:$P(DATA,U,8)'=1 ;...............Team Assign not PC
  1. .. Q:$P(DATA,U,9)]"" ;...............Team Assign inactive
  1. .. S POSN=$$POSNAME(POSI)
  1. .. S TMN=$$TMNAME(TMI)
  1. .. S DFNNAM=$$PTNAME(DFN) ;Patient name
  1. .. ;
  1. .. D CHECK67
  1. .. ;
  1. .. S CNT=CNT+1
  1. .. ;Save 1st occurance. Asingle occurance is not a problem.
  1. .. I CNT=1 S HLD(DFNNAM,DFN,3,TMN,POSN)="" Q
  1. .. ;
  1. .. ;If there is a 2nd occurance, move 1st occurance into array.
  1. .. I CNT=2 M ^TMP("PCMM PATIENT",$J)=HLD KILL HLD
  1. .. S ^TMP("PCMM PATIENT",$J,DFNNAM,DFN,3,TMN,POSN)=PTPI ;..........#3
  1. Q
  1. ;
  1. CHECK45(TMI,POSI) ;Check positions for inconsistencies 4 & 5.
  1. ;Input:
  1. ; TMI - Team IEN
  1. ; POSI - Team Position IEN
  1. ;
  1. NEW AP,DATA,PCP,POSN,PREHI,STAFFAP,STAFFPCP,TMN
  1. ;
  1. S PREHI=0
  1. F S PREHI=$O(^SCTM(404.53,"B",POSI,PREHI)) Q:'PREHI D ;
  1. . S DATA=$G(^SCTM(404.53,PREHI,0))
  1. . Q:DATA']""
  1. . S AP=$P(DATA,U,1) ;.....................Preceptee position
  1. . S PCP=$P(DATA,U,6) ;....................Preceptor position
  1. . S STAFFAP=+$$GETPRTP^SCAPMCU2(AP,DT) ;..Preceptee staff person
  1. . S STAFFPCP=+$$GETPRTP^SCAPMCU2(PCP,DT) ;Preceptor staff person
  1. . ;
  1. . S TMN=$$TMNAME(TMI)
  1. . S POSN=$$POSNAME(POSI)
  1. . I STAFFAP,STAFFAP=STAFFPCP D ;
  1. .. S ^TMP("PCMM POSITION",$J,4,TMN,POSN)="" ;......................#4
  1. . I STAFFPCP="" D ;
  1. .. S ^TMP("PCMM POSITION",$J,5,TMN,POSN)="" ;......................#5
  1. Q
  1. ;
  1. CHECK67 ;Check patients for inconsistencies 6 & 7.
  1. NEW ERROR,ID,LIST,NUM,POS,RESULT,TYPE,ZDATE
  1. ;
  1. S ZDATE("BEGIN")=DT
  1. S ZDATE("END")=DT
  1. S ZDATE("INCL")=0
  1. ;
  1. S RESULT=$$PRPTTPC^SCAPMC(PTPI,"ZDATE","LIST","ERROR",1)
  1. ;
  1. S NUM=0
  1. F S NUM=$O(LIST(NUM)) Q:'NUM D ;
  1. . S TYPE=""
  1. . F S TYPE=$O(LIST(NUM,TYPE)) Q:TYPE="" D ;
  1. .. S ID=""
  1. .. F S ID=$O(LIST(NUM,TYPE,ID)) Q:ID="" D ;
  1. ... S POS=$P(LIST(NUM,TYPE,ID),U,3) Q:'POS
  1. ... ;See if field 4, POSSIBLE PRIMARY PRACTITIONER, equals 1.
  1. ... Q:$P($G(^SCTM(404.57,POS,0)),U,4)=1
  1. ... I TYPE="AP" D Q
  1. .... S ^TMP("PCMM PATIENT",$J,DFNNAM,DFN,6,TMN,POSN)=PTPI ;........#6
  1. ... I TYPE="PCP" D Q
  1. .... S ^TMP("PCMM PATIENT",$J,DFNNAM,DFN,7,TMN,POSN)=PTPI ;........#7
  1. Q
  1. ;
  1. TMNAME(TMI) ;Return team name
  1. NEW NAME
  1. S NAME=$P($G(^SCTM(404.51,TMI,0)),U,1)
  1. S:NAME="" NAME="UNKNOWN"
  1. Q NAME
  1. ;
  1. POSNAME(POSI) ;Return position name
  1. NEW NAME
  1. S NAME=$P($G(^SCTM(404.57,POSI,0)),U,1)
  1. S:NAME="" NAME="UNKNOWN"
  1. Q NAME
  1. ;
  1. PTNAME(DFN) ;Return patient name
  1. NEW NAME
  1. S NAME=$P($G(^DPT(DFN,0)),U,1)
  1. S:NAME="" NAME="UNKNOWN"
  1. Q NAME