- SCRPV1B ; bp/djb - PCMM Inconsistency Rpt - Print ; 9/13/99 3:23pm
- ;;5.3;Scheduling;**177,231,1015**;AUG 13, 1993;Build 21
- ;IHS/ANMC/LJF 11/02/2000 changed SSN to HRCN
- ;
- EN ;
- NEW PAGE,QUIT
- S QUIT=0
- D HD
- D POSITION Q:QUIT
- D PATIENT
- Q
- ;
- POSITION ;Print position inconsistencies.
- NEW NUM,POS,TM,TXT
- ;
- W !!,"POSITION INCONSISTENCIES"
- W !,"------------------------",!
- I '$D(^TMP("PCMM POSITION",$J)) W !?3,"No inconsistencies found." Q
- I SCMODE="B" D BRIEFPOS^SCRPV1B1 Q ;Report type = Brief
- W !?3,"INCONSISTENCY"
- W !?6,"TEAM",?38,"POSITION",!
- ;
- ;Process the POSITION array
- S NUM=0
- F S NUM=$O(^TMP("PCMM POSITION",$J,NUM)) Q:'NUM!QUIT D ;
- . S TXT=$T(TXT+NUM)
- . S TXT=$P(TXT,";",4)
- . I $Y>(IOSL-6) D PAUSE Q:QUIT
- . W !?3,TXT
- . S TM=""
- . F S TM=$O(^TMP("PCMM POSITION",$J,NUM,TM)) Q:TM=""!QUIT D
- .. S POS=""
- .. F S POS=$O(^TMP("PCMM POSITION",$J,NUM,TM,POS)) Q:POS=""!QUIT D
- ... I $Y>(IOSL-6) D PAUSE Q:QUIT
- ... W !,?6,TM,?38,POS
- Q
- ;
- PATIENT ;Print patient inconsistencies
- ;
- I $Y>(IOSL-7) D PAUSE Q:QUIT
- W !!,"PATIENT INCONSISTENCIES"
- W !,"-----------------------",!
- I '$D(^TMP("PCMM PATIENT",$J)) D Q
- . W !?3,"No inconsistencies found.",!
- I $Y>(IOSL-6) D PAUSE Q:QUIT
- I SCMODE="B" D BRIEFPT^SCRPV1B1 Q ;Report type = Brief
- I SCMODE="DP" D PATIENT1 Q
- I SCMODE="DT" D PATIENT2 Q
- Q
- ;
- PATIENT1 ;Patient printout sorted by patient name.
- NEW DFN,DFNNAM,NUM,POS,SSN,TM,TXT,VAR
- ;
- ;W !?3,"PATIENT",?41,"SSN" ;IHS/ANMC/LJF 11/2/2000
- W !?3,"PATIENT",?41,"ID#" ;IHS/ANMC/LJF 11/2/2000
- W !?6,"INCONSISTENCY"
- W !?9,"TEAM",?41,"POSITION",!
- ;
- ;Process the PATIENT array
- S DFNNAM=""
- F S DFNNAM=$O(^TMP("PCMM PATIENT",$J,DFNNAM)) Q:DFNNAM=""!QUIT D ;
- . S DFN=0
- . F S DFN=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN)) Q:'DFN!QUIT D ;
- .. I $Y>(IOSL-6) D PAUSE Q:QUIT
- .. S SSN=$P($G(^DPT(DFN,0)),U,9)
- .. S SSN=$$HRCN^BDGF2(DFN,+$G(DUZ(2))) ;IHS/ANMC/LJF 11/2/2000
- .. W !?3,DFNNAM,?41,SSN
- .. S NUM=0
- .. F S NUM=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM)) Q:'NUM!QUIT D
- ... S VAR=0
- ... ;If number is 8.1, 8.2 or 8.3, substitute in 3 choices below.
- ... I NUM?1"8.".E S VAR=$P(NUM,".",2)
- ... S TXT=$T(TXT+(NUM\1))
- ... S TXT=$P(TXT,";",4)
- ... I VAR D ;
- .... S VAR=$S(VAR=1:"Team Assignment",VAR=2:"Team",1:"Position")
- .... S TXT=$P(TXT,"[]",1)_VAR_$P(TXT,"[]",2)
- ... I $Y>(IOSL-6) D PAUSE Q:QUIT
- ... ;W !?6,(NUM\1),". ",TXT
- ... W !?6,TXT
- ... S TM=""
- ... F S TM=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM,TM)) Q:TM=""!QUIT D
- .... S POS=""
- .... F S POS=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM,TM,POS)) Q:POS=""!QUIT D
- ..... I $Y>(IOSL-6) D PAUSE Q:QUIT
- ..... W !?9,TM,?41,POS
- ..... ;
- ..... ;Print 404.43 IEN if SCIEN is set to 1 before calling ^SCRPV1.
- ..... I $G(SCIEN) D ;
- ...... I $G(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM,TM,POS)) W ?72,^(POS)
- Q
- ;
- PATIENT2 ;Patient printout sorted by inconsistency number and then team name.
- NEW DFN,DFNNAM,NUM,POS,SSN,TM,TXT,VAR
- ;
- W !,"INCONSISTENCY"
- W !?3,"TEAM"
- ;W !?6,"PATIENT",?38,"SSN",?50,"POSITION",! ;IHS/ANMC/LJF 11/2/2000
- W !?6,"PATIENT",?38,"ID#",?50,"POSITION",! ;IHS/ANMC/LJF 11/2/2000
- ;
- KILL ^TMP("PCMM PATIENT1",$J)
- ;
- ;Reorder PATIENT array
- S DFNNAM=""
- F S DFNNAM=$O(^TMP("PCMM PATIENT",$J,DFNNAM)) Q:DFNNAM="" D ;
- . S DFN=0
- . F S DFN=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN)) Q:'DFN D ;
- .. S NUM=0
- .. F S NUM=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM)) Q:'NUM D ;
- ... S TM=""
- ... F S TM=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM,TM)) Q:TM="" D
- .... S POS=""
- .... F S POS=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM,TM,POS)) Q:POS="" D
- ..... S ^TMP("PCMM PATIENT1",$J,NUM,TM,DFNNAM,DFN,POS)=""
- ;
- ;Process new array
- S NUM=0
- F S NUM=$O(^TMP("PCMM PATIENT1",$J,NUM)) Q:'NUM!QUIT D ;
- . S VAR=0
- . ;If number is 8.1, 8.2 or 8.3, substitute in 3 choices below.
- . I NUM?1"8.".E S VAR=$P(NUM,".",2)
- . S TXT=$T(TXT+(NUM\1))
- . S TXT=$P(TXT,";",4)
- . I VAR D ;
- .. S VAR=$S(VAR=1:"Team Assignment",VAR=2:"Team",1:"Position")
- .. S TXT=$P(TXT,"[]",1)_VAR_$P(TXT,"[]",2)
- . ;
- . I $Y>(IOSL-6) D PAUSE Q:QUIT
- . W !,TXT
- . ;
- . S TM=""
- . F S TM=$O(^TMP("PCMM PATIENT1",$J,NUM,TM)) Q:TM=""!QUIT D ;
- .. I $Y>(IOSL-6) D PAUSE Q:QUIT
- .. W !?3,TM
- .. S DFNNAM=""
- .. F S DFNNAM=$O(^TMP("PCMM PATIENT1",$J,NUM,TM,DFNNAM)) Q:DFNNAM=""!QUIT D ;
- ... S DFN=0
- ... F S DFN=$O(^TMP("PCMM PATIENT1",$J,NUM,TM,DFNNAM,DFN)) Q:'DFN!QUIT D
- .... S POS=0
- .... F S POS=$O(^TMP("PCMM PATIENT1",$J,NUM,TM,DFNNAM,DFN,POS)) Q:'POS!QUIT D ;
- ..... S SSN=$P($G(^DPT(DFN,0)),U,9)
- ..... I $Y>(IOSL-6) D PAUSE Q:QUIT
- ..... W !?6,DFNNAM,?38,SSN,?50,POS
- ;
- KILL ^TMP("PCMM PATIENT1",$J)
- Q
- ;
- PAUSE ;Pause the display
- NEW ANS,COL,PGTXT
- S PAGE=PAGE+1
- I $G(ION)="HFS" Q
- S PGTXT="Page: "_PAGE
- S COL=(IOM-$L(PGTXT)-2)
- I $E(IOST,1,2)="P-" W @IOF,!?COL,PGTXT Q
- W !,"<RET> to continue, ^ to quit: "
- R ANS:DTIME S:'$T ANS="^" I ANS["^" S QUIT=1 Q
- W @IOF,!?COL,PGTXT
- Q
- ;
- HD ;Heading
- NEW HD,LINE,NOW,TM,TMN
- ;
- S PAGE=1
- S HD="PCMM INCONSISTENCY REPORT"
- ;Adjust heading if going to the P-MESSAGE device
- I IOST["P-",IOST["MESSAGE" D Q
- . W !?(78-$L(HD)\2),HD
- ;
- I $E(IOST,1,2)="P-" W !!
- E W @IOF
- S $P(LINE,"=",IOM)=""
- W !?(IOM-$L(HD)\2),HD
- S NOW=$$NOW^XLFDT()
- I $P(NOW,".",2) S NOW=$P(NOW,".",1)_"."_$E($P(NOW,".",2),1,4)
- S HD=$$FMTE^XLFDT(NOW)
- W !?(IOM-$L(HD)\2),HD
- W !,LINE
- I SCTYPE("TM")="I" D ;
- . W !,"See PCMM User Guide for detailed instructions."
- E D ;
- . W !,"Teams: "
- . I SCTYPE("TM")="A" W "All teams"
- . E D ;
- .. S TM=0
- .. F S TM=$O(SCTM(TM)) Q:'TM D ;
- ... S TMN=$P($G(^SCTM(404.51,TM,0)),U,1)
- ... S:TMN']"" TMN="UNKNOWN"
- ... I ($L(TMN)+$X+2)>IOM W !?7
- ... W TMN
- ... I $O(SCTM(TM)) W ", "
- W !,LINE
- Q
- ;
- TXT ;Inconsistencies
- ;;1;Position has no staff assigned
- ;;2;Patient has no PCP assigned
- ;;3;Patient has multiple PCPs assigned
- ;;4;AP & PCP are the same provider
- ;;5;AP is without a Preceptor
- ;;6;AP position is not designated for PC
- ;;7;PCP position is not designated for PC
- ;;8;Position assignment with inactive []
- Q
- SCRPV1B ; bp/djb - PCMM Inconsistency Rpt - Print ; 9/13/99 3:23pm
- +1 ;;5.3;Scheduling;**177,231,1015**;AUG 13, 1993;Build 21
- +2 ;IHS/ANMC/LJF 11/02/2000 changed SSN to HRCN
- +3 ;
- EN ;
- +1 NEW PAGE,QUIT
- +2 SET QUIT=0
- +3 DO HD
- +4 DO POSITION
- IF QUIT
- QUIT
- +5 DO PATIENT
- +6 QUIT
- +7 ;
- POSITION ;Print position inconsistencies.
- +1 NEW NUM,POS,TM,TXT
- +2 ;
- +3 WRITE !!,"POSITION INCONSISTENCIES"
- +4 WRITE !,"------------------------",!
- +5 IF '$DATA(^TMP("PCMM POSITION",$JOB))
- WRITE !?3,"No inconsistencies found."
- QUIT
- +6 ;Report type = Brief
- IF SCMODE="B"
- DO BRIEFPOS^SCRPV1B1
- QUIT
- +7 WRITE !?3,"INCONSISTENCY"
- +8 WRITE !?6,"TEAM",?38,"POSITION",!
- +9 ;
- +10 ;Process the POSITION array
- +11 SET NUM=0
- +12 ;
- FOR
- SET NUM=$ORDER(^TMP("PCMM POSITION",$JOB,NUM))
- IF 'NUM!QUIT
- QUIT
- Begin DoDot:1
- +13 SET TXT=$TEXT(TXT+NUM)
- +14 SET TXT=$PIECE(TXT,";",4)
- +15 IF $Y>(IOSL-6)
- DO PAUSE
- IF QUIT
- QUIT
- +16 WRITE !?3,TXT
- +17 SET TM=""
- +18 FOR
- SET TM=$ORDER(^TMP("PCMM POSITION",$JOB,NUM,TM))
- IF TM=""!QUIT
- QUIT
- Begin DoDot:2
- +19 SET POS=""
- +20 FOR
- SET POS=$ORDER(^TMP("PCMM POSITION",$JOB,NUM,TM,POS))
- IF POS=""!QUIT
- QUIT
- Begin DoDot:3
- +21 IF $Y>(IOSL-6)
- DO PAUSE
- IF QUIT
- QUIT
- +22 WRITE !,?6,TM,?38,POS
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +23 QUIT
- +24 ;
- PATIENT ;Print patient inconsistencies
- +1 ;
- +2 IF $Y>(IOSL-7)
- DO PAUSE
- IF QUIT
- QUIT
- +3 WRITE !!,"PATIENT INCONSISTENCIES"
- +4 WRITE !,"-----------------------",!
- +5 IF '$DATA(^TMP("PCMM PATIENT",$JOB))
- Begin DoDot:1
- +6 WRITE !?3,"No inconsistencies found.",!
- End DoDot:1
- QUIT
- +7 IF $Y>(IOSL-6)
- DO PAUSE
- IF QUIT
- QUIT
- +8 ;Report type = Brief
- IF SCMODE="B"
- DO BRIEFPT^SCRPV1B1
- QUIT
- +9 IF SCMODE="DP"
- DO PATIENT1
- QUIT
- +10 IF SCMODE="DT"
- DO PATIENT2
- QUIT
- +11 QUIT
- +12 ;
- PATIENT1 ;Patient printout sorted by patient name.
- +1 NEW DFN,DFNNAM,NUM,POS,SSN,TM,TXT,VAR
- +2 ;
- +3 ;W !?3,"PATIENT",?41,"SSN" ;IHS/ANMC/LJF 11/2/2000
- +4 ;IHS/ANMC/LJF 11/2/2000
- WRITE !?3,"PATIENT",?41,"ID#"
- +5 WRITE !?6,"INCONSISTENCY"
- +6 WRITE !?9,"TEAM",?41,"POSITION",!
- +7 ;
- +8 ;Process the PATIENT array
- +9 SET DFNNAM=""
- +10 ;
- FOR
- SET DFNNAM=$ORDER(^TMP("PCMM PATIENT",$JOB,DFNNAM))
- IF DFNNAM=""!QUIT
- QUIT
- Begin DoDot:1
- +11 SET DFN=0
- +12 ;
- FOR
- SET DFN=$ORDER(^TMP("PCMM PATIENT",$JOB,DFNNAM,DFN))
- IF 'DFN!QUIT
- QUIT
- Begin DoDot:2
- +13 IF $Y>(IOSL-6)
- DO PAUSE
- IF QUIT
- QUIT
- +14 SET SSN=$PIECE($GET(^DPT(DFN,0)),U,9)
- +15 ;IHS/ANMC/LJF 11/2/2000
- SET SSN=$$HRCN^BDGF2(DFN,+$GET(DUZ(2)))
- +16 WRITE !?3,DFNNAM,?41,SSN
- +17 SET NUM=0
- +18 FOR
- SET NUM=$ORDER(^TMP("PCMM PATIENT",$JOB,DFNNAM,DFN,NUM))
- IF 'NUM!QUIT
- QUIT
- Begin DoDot:3
- +19 SET VAR=0
- +20 ;If number is 8.1, 8.2 or 8.3, substitute in 3 choices below.
- +21 IF NUM?1"8.".E
- SET VAR=$PIECE(NUM,".",2)
- +22 SET TXT=$TEXT(TXT+(NUM\1))
- +23 SET TXT=$PIECE(TXT,";",4)
- +24 ;
- IF VAR
- Begin DoDot:4
- +25 SET VAR=$SELECT(VAR=1:"Team Assignment",VAR=2:"Team",1:"Position")
- +26 SET TXT=$PIECE(TXT,"[]",1)_VAR_$PIECE(TXT,"[]",2)
- End DoDot:4
- +27 IF $Y>(IOSL-6)
- DO PAUSE
- IF QUIT
- QUIT
- +28 ;W !?6,(NUM\1),". ",TXT
- +29 WRITE !?6,TXT
- +30 SET TM=""
- +31 FOR
- SET TM=$ORDER(^TMP("PCMM PATIENT",$JOB,DFNNAM,DFN,NUM,TM))
- IF TM=""!QUIT
- QUIT
- Begin DoDot:4
- +32 SET POS=""
- +33 FOR
- SET POS=$ORDER(^TMP("PCMM PATIENT",$JOB,DFNNAM,DFN,NUM,TM,POS))
- IF POS=""!QUIT
- QUIT
- Begin DoDot:5
- +34 IF $Y>(IOSL-6)
- DO PAUSE
- IF QUIT
- QUIT
- +35 WRITE !?9,TM,?41,POS
- +36 ;
- +37 ;Print 404.43 IEN if SCIEN is set to 1 before calling ^SCRPV1.
- +38 ;
- IF $GET(SCIEN)
- Begin DoDot:6
- +39 IF $GET(^TMP("PCMM PATIENT",$JOB,DFNNAM,DFN,NUM,TM,POS))
- WRITE ?72,^(POS)
- End DoDot:6
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +40 QUIT
- +41 ;
- PATIENT2 ;Patient printout sorted by inconsistency number and then team name.
- +1 NEW DFN,DFNNAM,NUM,POS,SSN,TM,TXT,VAR
- +2 ;
- +3 WRITE !,"INCONSISTENCY"
- +4 WRITE !?3,"TEAM"
- +5 ;W !?6,"PATIENT",?38,"SSN",?50,"POSITION",! ;IHS/ANMC/LJF 11/2/2000
- +6 ;IHS/ANMC/LJF 11/2/2000
- WRITE !?6,"PATIENT",?38,"ID#",?50,"POSITION",!
- +7 ;
- +8 KILL ^TMP("PCMM PATIENT1",$JOB)
- +9 ;
- +10 ;Reorder PATIENT array
- +11 SET DFNNAM=""
- +12 ;
- FOR
- SET DFNNAM=$ORDER(^TMP("PCMM PATIENT",$JOB,DFNNAM))
- IF DFNNAM=""
- QUIT
- Begin DoDot:1
- +13 SET DFN=0
- +14 ;
- FOR
- SET DFN=$ORDER(^TMP("PCMM PATIENT",$JOB,DFNNAM,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:2
- +15 SET NUM=0
- +16 ;
- FOR
- SET NUM=$ORDER(^TMP("PCMM PATIENT",$JOB,DFNNAM,DFN,NUM))
- IF 'NUM
- QUIT
- Begin DoDot:3
- +17 SET TM=""
- +18 FOR
- SET TM=$ORDER(^TMP("PCMM PATIENT",$JOB,DFNNAM,DFN,NUM,TM))
- IF TM=""
- QUIT
- Begin DoDot:4
- +19 SET POS=""
- +20 FOR
- SET POS=$ORDER(^TMP("PCMM PATIENT",$JOB,DFNNAM,DFN,NUM,TM,POS))
- IF POS=""
- QUIT
- Begin DoDot:5
- +21 SET ^TMP("PCMM PATIENT1",$JOB,NUM,TM,DFNNAM,DFN,POS)=""
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +22 ;
- +23 ;Process new array
- +24 SET NUM=0
- +25 ;
- FOR
- SET NUM=$ORDER(^TMP("PCMM PATIENT1",$JOB,NUM))
- IF 'NUM!QUIT
- QUIT
- Begin DoDot:1
- +26 SET VAR=0
- +27 ;If number is 8.1, 8.2 or 8.3, substitute in 3 choices below.
- +28 IF NUM?1"8.".E
- SET VAR=$PIECE(NUM,".",2)
- +29 SET TXT=$TEXT(TXT+(NUM\1))
- +30 SET TXT=$PIECE(TXT,";",4)
- +31 ;
- IF VAR
- Begin DoDot:2
- +32 SET VAR=$SELECT(VAR=1:"Team Assignment",VAR=2:"Team",1:"Position")
- +33 SET TXT=$PIECE(TXT,"[]",1)_VAR_$PIECE(TXT,"[]",2)
- End DoDot:2
- +34 ;
- +35 IF $Y>(IOSL-6)
- DO PAUSE
- IF QUIT
- QUIT
- +36 WRITE !,TXT
- +37 ;
- +38 SET TM=""
- +39 ;
- FOR
- SET TM=$ORDER(^TMP("PCMM PATIENT1",$JOB,NUM,TM))
- IF TM=""!QUIT
- QUIT
- Begin DoDot:2
- +40 IF $Y>(IOSL-6)
- DO PAUSE
- IF QUIT
- QUIT
- +41 WRITE !?3,TM
- +42 SET DFNNAM=""
- +43 ;
- FOR
- SET DFNNAM=$ORDER(^TMP("PCMM PATIENT1",$JOB,NUM,TM,DFNNAM))
- IF DFNNAM=""!QUIT
- QUIT
- Begin DoDot:3
- +44 SET DFN=0
- +45 FOR
- SET DFN=$ORDER(^TMP("PCMM PATIENT1",$JOB,NUM,TM,DFNNAM,DFN))
- IF 'DFN!QUIT
- QUIT
- Begin DoDot:4
- +46 SET POS=0
- +47 ;
- FOR
- SET POS=$ORDER(^TMP("PCMM PATIENT1",$JOB,NUM,TM,DFNNAM,DFN,POS))
- IF 'POS!QUIT
- QUIT
- Begin DoDot:5
- +48 SET SSN=$PIECE($GET(^DPT(DFN,0)),U,9)
- +49 IF $Y>(IOSL-6)
- DO PAUSE
- IF QUIT
- QUIT
- +50 WRITE !?6,DFNNAM,?38,SSN,?50,POS
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +51 ;
- +52 KILL ^TMP("PCMM PATIENT1",$JOB)
- +53 QUIT
- +54 ;
- PAUSE ;Pause the display
- +1 NEW ANS,COL,PGTXT
- +2 SET PAGE=PAGE+1
- +3 IF $GET(ION)="HFS"
- QUIT
- +4 SET PGTXT="Page: "_PAGE
- +5 SET COL=(IOM-$LENGTH(PGTXT)-2)
- +6 IF $EXTRACT(IOST,1,2)="P-"
- WRITE @IOF,!?COL,PGTXT
- QUIT
- +7 WRITE !,"<RET> to continue, ^ to quit: "
- +8 READ ANS:DTIME
- IF '$TEST
- SET ANS="^"
- IF ANS["^"
- SET QUIT=1
- QUIT
- +9 WRITE @IOF,!?COL,PGTXT
- +10 QUIT
- +11 ;
- HD ;Heading
- +1 NEW HD,LINE,NOW,TM,TMN
- +2 ;
- +3 SET PAGE=1
- +4 SET HD="PCMM INCONSISTENCY REPORT"
- +5 ;Adjust heading if going to the P-MESSAGE device
- +6 IF IOST["P-"
- IF IOST["MESSAGE"
- Begin DoDot:1
- +7 WRITE !?(78-$LENGTH(HD)\2),HD
- End DoDot:1
- QUIT
- +8 ;
- +9 IF $EXTRACT(IOST,1,2)="P-"
- WRITE !!
- +10 IF '$TEST
- WRITE @IOF
- +11 SET $PIECE(LINE,"=",IOM)=""
- +12 WRITE !?(IOM-$LENGTH(HD)\2),HD
- +13 SET NOW=$$NOW^XLFDT()
- +14 IF $PIECE(NOW,".",2)
- SET NOW=$PIECE(NOW,".",1)_"."_$EXTRACT($PIECE(NOW,".",2),1,4)
- +15 SET HD=$$FMTE^XLFDT(NOW)
- +16 WRITE !?(IOM-$LENGTH(HD)\2),HD
- +17 WRITE !,LINE
- +18 ;
- IF SCTYPE("TM")="I"
- Begin DoDot:1
- +19 WRITE !,"See PCMM User Guide for detailed instructions."
- End DoDot:1
- +20 ;
- IF '$TEST
- Begin DoDot:1
- +21 WRITE !,"Teams: "
- +22 IF SCTYPE("TM")="A"
- WRITE "All teams"
- +23 ;
- IF '$TEST
- Begin DoDot:2
- +24 SET TM=0
- +25 ;
- FOR
- SET TM=$ORDER(SCTM(TM))
- IF 'TM
- QUIT
- Begin DoDot:3
- +26 SET TMN=$PIECE($GET(^SCTM(404.51,TM,0)),U,1)
- +27 IF TMN']""
- SET TMN="UNKNOWN"
- +28 IF ($LENGTH(TMN)+$X+2)>IOM
- WRITE !?7
- +29 WRITE TMN
- +30 IF $ORDER(SCTM(TM))
- WRITE ", "
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +31 WRITE !,LINE
- +32 QUIT
- +33 ;
- TXT ;Inconsistencies
- +1 ;;1;Position has no staff assigned
- +2 ;;2;Patient has no PCP assigned
- +3 ;;3;Patient has multiple PCPs assigned
- +4 ;;4;AP & PCP are the same provider
- +5 ;;5;AP is without a Preceptor
- +6 ;;6;AP position is not designated for PC
- +7 ;;7;PCP position is not designated for PC
- +8 ;;8;Position assignment with inactive []
- +9 QUIT