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

SCRPV1B.m

Go to the documentation of this file.
  1. SCRPV1B ; bp/djb - PCMM Inconsistency Rpt - Print ; 9/13/99 3:23pm
  1. ;;5.3;Scheduling;**177,231,1015**;AUG 13, 1993;Build 21
  1. ;IHS/ANMC/LJF 11/02/2000 changed SSN to HRCN
  1. ;
  1. EN ;
  1. NEW PAGE,QUIT
  1. S QUIT=0
  1. D HD
  1. D POSITION Q:QUIT
  1. D PATIENT
  1. Q
  1. ;
  1. POSITION ;Print position inconsistencies.
  1. NEW NUM,POS,TM,TXT
  1. ;
  1. W !!,"POSITION INCONSISTENCIES"
  1. W !,"------------------------",!
  1. I '$D(^TMP("PCMM POSITION",$J)) W !?3,"No inconsistencies found." Q
  1. I SCMODE="B" D BRIEFPOS^SCRPV1B1 Q ;Report type = Brief
  1. W !?3,"INCONSISTENCY"
  1. W !?6,"TEAM",?38,"POSITION",!
  1. ;
  1. ;Process the POSITION array
  1. S NUM=0
  1. F S NUM=$O(^TMP("PCMM POSITION",$J,NUM)) Q:'NUM!QUIT D ;
  1. . S TXT=$T(TXT+NUM)
  1. . S TXT=$P(TXT,";",4)
  1. . I $Y>(IOSL-6) D PAUSE Q:QUIT
  1. . W !?3,TXT
  1. . S TM=""
  1. . F S TM=$O(^TMP("PCMM POSITION",$J,NUM,TM)) Q:TM=""!QUIT D
  1. .. S POS=""
  1. .. F S POS=$O(^TMP("PCMM POSITION",$J,NUM,TM,POS)) Q:POS=""!QUIT D
  1. ... I $Y>(IOSL-6) D PAUSE Q:QUIT
  1. ... W !,?6,TM,?38,POS
  1. Q
  1. ;
  1. PATIENT ;Print patient inconsistencies
  1. ;
  1. I $Y>(IOSL-7) D PAUSE Q:QUIT
  1. W !!,"PATIENT INCONSISTENCIES"
  1. W !,"-----------------------",!
  1. I '$D(^TMP("PCMM PATIENT",$J)) D Q
  1. . W !?3,"No inconsistencies found.",!
  1. I $Y>(IOSL-6) D PAUSE Q:QUIT
  1. I SCMODE="B" D BRIEFPT^SCRPV1B1 Q ;Report type = Brief
  1. I SCMODE="DP" D PATIENT1 Q
  1. I SCMODE="DT" D PATIENT2 Q
  1. Q
  1. ;
  1. PATIENT1 ;Patient printout sorted by patient name.
  1. NEW DFN,DFNNAM,NUM,POS,SSN,TM,TXT,VAR
  1. ;
  1. ;W !?3,"PATIENT",?41,"SSN" ;IHS/ANMC/LJF 11/2/2000
  1. W !?3,"PATIENT",?41,"ID#" ;IHS/ANMC/LJF 11/2/2000
  1. W !?6,"INCONSISTENCY"
  1. W !?9,"TEAM",?41,"POSITION",!
  1. ;
  1. ;Process the PATIENT array
  1. S DFNNAM=""
  1. F S DFNNAM=$O(^TMP("PCMM PATIENT",$J,DFNNAM)) Q:DFNNAM=""!QUIT D ;
  1. . S DFN=0
  1. . F S DFN=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN)) Q:'DFN!QUIT D ;
  1. .. I $Y>(IOSL-6) D PAUSE Q:QUIT
  1. .. S SSN=$P($G(^DPT(DFN,0)),U,9)
  1. .. S SSN=$$HRCN^BDGF2(DFN,+$G(DUZ(2))) ;IHS/ANMC/LJF 11/2/2000
  1. .. W !?3,DFNNAM,?41,SSN
  1. .. S NUM=0
  1. .. F S NUM=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM)) Q:'NUM!QUIT D
  1. ... S VAR=0
  1. ... ;If number is 8.1, 8.2 or 8.3, substitute in 3 choices below.
  1. ... I NUM?1"8.".E S VAR=$P(NUM,".",2)
  1. ... S TXT=$T(TXT+(NUM\1))
  1. ... S TXT=$P(TXT,";",4)
  1. ... I VAR D ;
  1. .... S VAR=$S(VAR=1:"Team Assignment",VAR=2:"Team",1:"Position")
  1. .... S TXT=$P(TXT,"[]",1)_VAR_$P(TXT,"[]",2)
  1. ... I $Y>(IOSL-6) D PAUSE Q:QUIT
  1. ... ;W !?6,(NUM\1),". ",TXT
  1. ... W !?6,TXT
  1. ... S TM=""
  1. ... F S TM=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM,TM)) Q:TM=""!QUIT D
  1. .... S POS=""
  1. .... F S POS=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM,TM,POS)) Q:POS=""!QUIT D
  1. ..... I $Y>(IOSL-6) D PAUSE Q:QUIT
  1. ..... W !?9,TM,?41,POS
  1. ..... ;
  1. ..... ;Print 404.43 IEN if SCIEN is set to 1 before calling ^SCRPV1.
  1. ..... I $G(SCIEN) D ;
  1. ...... I $G(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM,TM,POS)) W ?72,^(POS)
  1. Q
  1. ;
  1. PATIENT2 ;Patient printout sorted by inconsistency number and then team name.
  1. NEW DFN,DFNNAM,NUM,POS,SSN,TM,TXT,VAR
  1. ;
  1. W !,"INCONSISTENCY"
  1. W !?3,"TEAM"
  1. ;W !?6,"PATIENT",?38,"SSN",?50,"POSITION",! ;IHS/ANMC/LJF 11/2/2000
  1. W !?6,"PATIENT",?38,"ID#",?50,"POSITION",! ;IHS/ANMC/LJF 11/2/2000
  1. ;
  1. KILL ^TMP("PCMM PATIENT1",$J)
  1. ;
  1. ;Reorder PATIENT array
  1. S DFNNAM=""
  1. F S DFNNAM=$O(^TMP("PCMM PATIENT",$J,DFNNAM)) Q:DFNNAM="" D ;
  1. . S DFN=0
  1. . F S DFN=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN)) Q:'DFN D ;
  1. .. S NUM=0
  1. .. F S NUM=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM)) Q:'NUM D ;
  1. ... S TM=""
  1. ... F S TM=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM,TM)) Q:TM="" D
  1. .... S POS=""
  1. .... F S POS=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM,TM,POS)) Q:POS="" D
  1. ..... S ^TMP("PCMM PATIENT1",$J,NUM,TM,DFNNAM,DFN,POS)=""
  1. ;
  1. ;Process new array
  1. S NUM=0
  1. F S NUM=$O(^TMP("PCMM PATIENT1",$J,NUM)) Q:'NUM!QUIT D ;
  1. . S VAR=0
  1. . ;If number is 8.1, 8.2 or 8.3, substitute in 3 choices below.
  1. . I NUM?1"8.".E S VAR=$P(NUM,".",2)
  1. . S TXT=$T(TXT+(NUM\1))
  1. . S TXT=$P(TXT,";",4)
  1. . I VAR D ;
  1. .. S VAR=$S(VAR=1:"Team Assignment",VAR=2:"Team",1:"Position")
  1. .. S TXT=$P(TXT,"[]",1)_VAR_$P(TXT,"[]",2)
  1. . ;
  1. . I $Y>(IOSL-6) D PAUSE Q:QUIT
  1. . W !,TXT
  1. . ;
  1. . S TM=""
  1. . F S TM=$O(^TMP("PCMM PATIENT1",$J,NUM,TM)) Q:TM=""!QUIT D ;
  1. .. I $Y>(IOSL-6) D PAUSE Q:QUIT
  1. .. W !?3,TM
  1. .. S DFNNAM=""
  1. .. F S DFNNAM=$O(^TMP("PCMM PATIENT1",$J,NUM,TM,DFNNAM)) Q:DFNNAM=""!QUIT D ;
  1. ... S DFN=0
  1. ... F S DFN=$O(^TMP("PCMM PATIENT1",$J,NUM,TM,DFNNAM,DFN)) Q:'DFN!QUIT D
  1. .... S POS=0
  1. .... F S POS=$O(^TMP("PCMM PATIENT1",$J,NUM,TM,DFNNAM,DFN,POS)) Q:'POS!QUIT D ;
  1. ..... S SSN=$P($G(^DPT(DFN,0)),U,9)
  1. ..... I $Y>(IOSL-6) D PAUSE Q:QUIT
  1. ..... W !?6,DFNNAM,?38,SSN,?50,POS
  1. ;
  1. KILL ^TMP("PCMM PATIENT1",$J)
  1. Q
  1. ;
  1. PAUSE ;Pause the display
  1. NEW ANS,COL,PGTXT
  1. S PAGE=PAGE+1
  1. I $G(ION)="HFS" Q
  1. S PGTXT="Page: "_PAGE
  1. S COL=(IOM-$L(PGTXT)-2)
  1. I $E(IOST,1,2)="P-" W @IOF,!?COL,PGTXT Q
  1. W !,"<RET> to continue, ^ to quit: "
  1. R ANS:DTIME S:'$T ANS="^" I ANS["^" S QUIT=1 Q
  1. W @IOF,!?COL,PGTXT
  1. Q
  1. ;
  1. HD ;Heading
  1. NEW HD,LINE,NOW,TM,TMN
  1. ;
  1. S PAGE=1
  1. S HD="PCMM INCONSISTENCY REPORT"
  1. ;Adjust heading if going to the P-MESSAGE device
  1. I IOST["P-",IOST["MESSAGE" D Q
  1. . W !?(78-$L(HD)\2),HD
  1. ;
  1. I $E(IOST,1,2)="P-" W !!
  1. E W @IOF
  1. S $P(LINE,"=",IOM)=""
  1. W !?(IOM-$L(HD)\2),HD
  1. S NOW=$$NOW^XLFDT()
  1. I $P(NOW,".",2) S NOW=$P(NOW,".",1)_"."_$E($P(NOW,".",2),1,4)
  1. S HD=$$FMTE^XLFDT(NOW)
  1. W !?(IOM-$L(HD)\2),HD
  1. W !,LINE
  1. I SCTYPE("TM")="I" D ;
  1. . W !,"See PCMM User Guide for detailed instructions."
  1. E D ;
  1. . W !,"Teams: "
  1. . I SCTYPE("TM")="A" W "All teams"
  1. . E D ;
  1. .. S TM=0
  1. .. F S TM=$O(SCTM(TM)) Q:'TM D ;
  1. ... S TMN=$P($G(^SCTM(404.51,TM,0)),U,1)
  1. ... S:TMN']"" TMN="UNKNOWN"
  1. ... I ($L(TMN)+$X+2)>IOM W !?7
  1. ... W TMN
  1. ... I $O(SCTM(TM)) W ", "
  1. W !,LINE
  1. Q
  1. ;
  1. TXT ;Inconsistencies
  1. ;;1;Position has no staff assigned
  1. ;;2;Patient has no PCP assigned
  1. ;;3;Patient has multiple PCPs assigned
  1. ;;4;AP & PCP are the same provider
  1. ;;5;AP is without a Preceptor
  1. ;;6;AP position is not designated for PC
  1. ;;7;PCP position is not designated for PC
  1. ;;8;Position assignment with inactive []
  1. Q