SCRPV1 ; bp/djb - PCMM Inconsistency Rpt - Main ; 8/25/99 9:52am
;;5.3;Scheduling;**177**;AUG 13, 1993
;
;This routine is part of Patch 177 (PCMM Phase II). It prompts for
;those Team and Position Assignments to be validated according to
;the business rules that have been established for PCMM and the
;relationship between Associate Provider and Preceptor.
;
;See tag IEN to include 404.43 IEN in printout.
;
EN ;
NEW QUIT,RESULT,SCMODE,SCPOS,SCTM,SCTYPE
TOP ;
KILL SCMODE,SCTM,SCTYPE
S QUIT=0
;
;Get teams to include in report.
S SCTYPE("TM")=$$ASKTM() G:SCTYPE("TM")=0 EXIT
I SCTYPE("TM")="S" D GETTM G:SCTM=0 TOP
;
;Get MODE: Brief/Detail
I SCTYPE("TM")'="I" S SCMODE=$$ASKMODE() G:SCMODE=0 TOP
;
S RESULT=$$DEVICE()
;
EXIT ; Cleanup and Exit
Q
;
RUN ;Gather the data and print the report.
;
KILL ^TMP("PCMM PATIENT",$J)
KILL ^TMP("PCMM POSITION",$J)
;
I SCTYPE("TM")="I" D LIST^SCRPV1B1 Q
I '$D(ZTQUEUED),'(IOST["P-"&(IOST["MESSAGE")) W "Please wait..."
;
D ^SCRPV1A ;............Gather data
D ^SCRPV1B ;............Print report
;
KILL ^TMP("PCMM PATIENT",$J)
KILL ^TMP("PCMM POSITION",$J)
Q
;
DEVICE() ; Select output device.
NEW POP,SCX,ZTDESC,ZTRTN,ZTSAVE
NEW %XX,%ZHFN,QUE
;
W ! I SCTYPE("TM")'="I" D ;
. W !,"This report may take a long time to run."
. W !,"Queuing is recommended.",!
;
S ZTRTN="RUN^SCRPV1"
S ZTDESC="PCMM Inconsistency Report"
S ZTSAVE("SC*")=""
S ZTSAVE("SCTYPE(")=""
S ZTSAVE("SCTM(")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
Q POP
;
ASKTM() ; Ask user to select teams.
; A = All Teams
; S = Select Teams
; Return: 0,A, or S.
;
NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
NEW COL,LINE
;
S $P(LINE,"-",IOM)=""
S COL=(IOM/2-12)
W @IOF,!?COL,"PCMM INCONSISTENCY REPORT"
W !,LINE
W !!,"T E A M S"
S DIR(0)="SMO^A:All Teams;S:Specific Teams;I:Inconsistency Descriptions"
S DIR("A")=" Select TEAMS"
S DIR("?")="Select I for a list of inconsistency descriptions"
S DIR("?",1)="Select A for a report of All Teams"
S DIR("?",2)="Select S for a report of Specific Teams"
D ^DIR
Q $S($D(DIRUT):0,1:Y)
;
GETTM ;Allow the user to select multiple teams.
;Set up SCTM array in format:
; SCTM(TeamName,TeamIEN)=""
;
NEW CNT,ND,TMI,TMN
NEW %,%Y,%Y1,C,DDH,X,SCESEQ,SCLSEQ,SCN
;
KILL SCTM
S SCTM=0
F W ! S TMI=$$TEAM^SCMCMU(DT) Q:TMI<0 D ;
. S ND=$G(^SCTM(404.51,TMI,0))
. S TMN=$P(ND,U,1)
. Q:TMN']""
. Q:$D(SCTM(TMI))
. S SCTM(TMI)=""
. S SCTM=SCTM+1
Q
;
ASKMODE() ; Which report type to run: BRIEF or DETAIL.
; B = Brief
; DP = Detailed by PATIENT
; DT = Detailed by TEAM
; Return: 0,B, or D.
;
NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
;
W !!,"R E P O R T T Y P E"
S DIR(0)="SMO^B:Brief;DP:Detailed by PATIENT;DT:Detailed by TEAM"
S DIR("A")=" Select REPORT TYPE"
S DIR("B")="DP"
S DIR("?")="Select DT for a detailed report by team"
S DIR("?",1)="Select B for a brief summary report"
S DIR("?",2)="Select DP for a detailed report by patient"
D ^DIR
Q $S($D(DIRUT):0,1:Y)
;
IEN ;Call here to include the 404.43 IEN on the right side of the
;printout for all type 8 inconsistencies. You can use this number
;to find the problem entry in Fileman. This feature only works
;with the DP print option.
;
NEW SCIEN
S SCIEN=1
G EN
;
MAIL(SCDUZ) ; Queue report as a MailMan Message.
NEW CNT,QUIT,RESULT,SCTYPE
NEW XMY,XMDUZ,XMSUB,XMTEXT
;
KILL ^TMP("PCMM PATIENT",$J)
KILL ^TMP("PCMM POSITION",$J)
KILL ^TMP("SCMSG",$J)
;
S CNT=1
D SET("This message was automatically generated by PCMM patch SD*5.3*177.")
;
S SCTYPE("TM")="A" ;All Teams & Positions
D ^SCRPV1A ;..Gather data
D MAILPOS ;...Build position inconsistency array
D MAILPT ;....Build patient inconsistency array
;
S XMDUZ=.5
S XMY(XMDUZ)=""
I $G(SCDUZ) S XMY(SCDUZ)=""
S XMSUB="PCMM INCONSISTENCY REPORT"
S XMTEXT="^TMP(""SCMSG"",$J,"
D ^XMD
;
KILL ^TMP("PCMM PATIENT",$J)
KILL ^TMP("PCMM POSITION",$J)
KILL ^TMP("SCMSG",$J)
Q
MAILPOS ;Print POSITION error counts only.
NEW ERROR,NUM,NUM1,POS,TM,TXT
;
S NUM=0
F S NUM=$O(^TMP("PCMM POSITION",$J,NUM)) Q:'NUM D ;
. S TM=""
. F S TM=$O(^TMP("PCMM POSITION",$J,NUM,TM)) Q:TM="" D ;
.. S POS=""
.. F S POS=$O(^TMP("PCMM POSITION",$J,NUM,TM,POS)) Q:POS="" D ;
... S ERROR(NUM\1)=($G(ERROR(NUM\1))+1)
;
D SET(" ")
D SET("POSITION INCONSISTENCIES")
D SET("------------------------")
D SET(" ")
I '$D(^TMP("PCMM POSITION",$J)) D Q
. D SET("No inconsistencies found.")
;
D SET("Total teams/positions per inconsistency type:")
S NUM=0
F S NUM=$O(ERROR(NUM)) Q:'NUM D ;
. S NUM1=(NUM\1)
. S TXT=$T(TXT+NUM1^SCRPV1B)
. ;W !?3,$P(TXT,";",3)_". "
. S TXT=$P(TXT,";",4)
. I TXT["[]" D ;
.. S TXT=$P(TXT,"[]",1)_"Team Assign/Team/Position"_$P(TXT,"[]",2)
. D SET(TXT_" - "_ERROR(NUM1))
Q
;
MAILPT ;Print PATIENT error counts only.
NEW DFN,DFNNAM,ERROR,NUM
;
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 ERROR("PT",NUM\1)=($G(ERROR("PT",NUM\1))+1)
;
D SET(" ")
D SET("PATIENT INCONSISTENCIES")
D SET("-----------------------")
D SET(" ")
I '$D(^TMP("PCMM PATIENT",$J)) D Q
. D SET("No inconsistencies found.")
;
D SET("Total patients per inconsistency type:")
S NUM=0
F S NUM=$O(ERROR("PT",NUM)) Q:'NUM D ;
. S NUM=NUM\1
. S TXT=$T(TXT+NUM^SCRPV1B)
. ;W !?3,$P(TXT,";",3)_". "
. S TXT=$P(TXT,";",4)
. I TXT["[]" D ;
.. S TXT=$P(TXT,"[]",1)_"Team Assign/Team/Position"_$P(TXT,"[]",2)
. D SET(TXT_" - "_ERROR("PT",NUM))
Q
;
SET(TXT) ;Build message array
S ^TMP("SCMSG",$J,CNT)=TXT
S CNT=CNT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPV1 5942 printed Sep 23, 2025@20:19:32 Page 2
SCRPV1 ; bp/djb - PCMM Inconsistency Rpt - Main ; 8/25/99 9:52am
+1 ;;5.3;Scheduling;**177**;AUG 13, 1993
+2 ;
+3 ;This routine is part of Patch 177 (PCMM Phase II). It prompts for
+4 ;those Team and Position Assignments to be validated according to
+5 ;the business rules that have been established for PCMM and the
+6 ;relationship between Associate Provider and Preceptor.
+7 ;
+8 ;See tag IEN to include 404.43 IEN in printout.
+9 ;
EN ;
+1 NEW QUIT,RESULT,SCMODE,SCPOS,SCTM,SCTYPE
TOP ;
+1 KILL SCMODE,SCTM,SCTYPE
+2 SET QUIT=0
+3 ;
+4 ;Get teams to include in report.
+5 SET SCTYPE("TM")=$$ASKTM()
if SCTYPE("TM")=0
GOTO EXIT
+6 IF SCTYPE("TM")="S"
DO GETTM
if SCTM=0
GOTO TOP
+7 ;
+8 ;Get MODE: Brief/Detail
+9 IF SCTYPE("TM")'="I"
SET SCMODE=$$ASKMODE()
if SCMODE=0
GOTO TOP
+10 ;
+11 SET RESULT=$$DEVICE()
+12 ;
EXIT ; Cleanup and Exit
+1 QUIT
+2 ;
RUN ;Gather the data and print the report.
+1 ;
+2 KILL ^TMP("PCMM PATIENT",$JOB)
+3 KILL ^TMP("PCMM POSITION",$JOB)
+4 ;
+5 IF SCTYPE("TM")="I"
DO LIST^SCRPV1B1
QUIT
+6 IF '$DATA(ZTQUEUED)
IF '(IOST["P-"&(IOST["MESSAGE"))
WRITE "Please wait..."
+7 ;
+8 ;............Gather data
DO ^SCRPV1A
+9 ;............Print report
DO ^SCRPV1B
+10 ;
+11 KILL ^TMP("PCMM PATIENT",$JOB)
+12 KILL ^TMP("PCMM POSITION",$JOB)
+13 QUIT
+14 ;
DEVICE() ; Select output device.
+1 NEW POP,SCX,ZTDESC,ZTRTN,ZTSAVE
+2 NEW %XX,%ZHFN,QUE
+3 ;
+4 ;
WRITE !
IF SCTYPE("TM")'="I"
Begin DoDot:1
+5 WRITE !,"This report may take a long time to run."
+6 WRITE !,"Queuing is recommended.",!
End DoDot:1
+7 ;
+8 SET ZTRTN="RUN^SCRPV1"
+9 SET ZTDESC="PCMM Inconsistency Report"
+10 SET ZTSAVE("SC*")=""
+11 SET ZTSAVE("SCTYPE(")=""
+12 SET ZTSAVE("SCTM(")=""
+13 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
+14 QUIT POP
+15 ;
ASKTM() ; Ask user to select teams.
+1 ; A = All Teams
+2 ; S = Select Teams
+3 ; Return: 0,A, or S.
+4 ;
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+6 NEW COL,LINE
+7 ;
+8 SET $PIECE(LINE,"-",IOM)=""
+9 SET COL=(IOM/2-12)
+10 WRITE @IOF,!?COL,"PCMM INCONSISTENCY REPORT"
+11 WRITE !,LINE
+12 WRITE !!,"T E A M S"
+13 SET DIR(0)="SMO^A:All Teams;S:Specific Teams;I:Inconsistency Descriptions"
+14 SET DIR("A")=" Select TEAMS"
+15 SET DIR("?")="Select I for a list of inconsistency descriptions"
+16 SET DIR("?",1)="Select A for a report of All Teams"
+17 SET DIR("?",2)="Select S for a report of Specific Teams"
+18 DO ^DIR
+19 QUIT $SELECT($DATA(DIRUT):0,1:Y)
+20 ;
GETTM ;Allow the user to select multiple teams.
+1 ;Set up SCTM array in format:
+2 ; SCTM(TeamName,TeamIEN)=""
+3 ;
+4 NEW CNT,ND,TMI,TMN
+5 NEW %,%Y,%Y1,C,DDH,X,SCESEQ,SCLSEQ,SCN
+6 ;
+7 KILL SCTM
+8 SET SCTM=0
+9 ;
FOR
WRITE !
SET TMI=$$TEAM^SCMCMU(DT)
if TMI<0
QUIT
Begin DoDot:1
+10 SET ND=$GET(^SCTM(404.51,TMI,0))
+11 SET TMN=$PIECE(ND,U,1)
+12 if TMN']""
QUIT
+13 if $DATA(SCTM(TMI))
QUIT
+14 SET SCTM(TMI)=""
+15 SET SCTM=SCTM+1
End DoDot:1
+16 QUIT
+17 ;
ASKMODE() ; Which report type to run: BRIEF or DETAIL.
+1 ; B = Brief
+2 ; DP = Detailed by PATIENT
+3 ; DT = Detailed by TEAM
+4 ; Return: 0,B, or D.
+5 ;
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+7 ;
+8 WRITE !!,"R E P O R T T Y P E"
+9 SET DIR(0)="SMO^B:Brief;DP:Detailed by PATIENT;DT:Detailed by TEAM"
+10 SET DIR("A")=" Select REPORT TYPE"
+11 SET DIR("B")="DP"
+12 SET DIR("?")="Select DT for a detailed report by team"
+13 SET DIR("?",1)="Select B for a brief summary report"
+14 SET DIR("?",2)="Select DP for a detailed report by patient"
+15 DO ^DIR
+16 QUIT $SELECT($DATA(DIRUT):0,1:Y)
+17 ;
IEN ;Call here to include the 404.43 IEN on the right side of the
+1 ;printout for all type 8 inconsistencies. You can use this number
+2 ;to find the problem entry in Fileman. This feature only works
+3 ;with the DP print option.
+4 ;
+5 NEW SCIEN
+6 SET SCIEN=1
+7 GOTO EN
+8 ;
MAIL(SCDUZ) ; Queue report as a MailMan Message.
+1 NEW CNT,QUIT,RESULT,SCTYPE
+2 NEW XMY,XMDUZ,XMSUB,XMTEXT
+3 ;
+4 KILL ^TMP("PCMM PATIENT",$JOB)
+5 KILL ^TMP("PCMM POSITION",$JOB)
+6 KILL ^TMP("SCMSG",$JOB)
+7 ;
+8 SET CNT=1
+9 DO SET("This message was automatically generated by PCMM patch SD*5.3*177.")
+10 ;
+11 ;All Teams & Positions
SET SCTYPE("TM")="A"
+12 ;..Gather data
DO ^SCRPV1A
+13 ;...Build position inconsistency array
DO MAILPOS
+14 ;....Build patient inconsistency array
DO MAILPT
+15 ;
+16 SET XMDUZ=.5
+17 SET XMY(XMDUZ)=""
+18 IF $GET(SCDUZ)
SET XMY(SCDUZ)=""
+19 SET XMSUB="PCMM INCONSISTENCY REPORT"
+20 SET XMTEXT="^TMP(""SCMSG"",$J,"
+21 DO ^XMD
+22 ;
+23 KILL ^TMP("PCMM PATIENT",$JOB)
+24 KILL ^TMP("PCMM POSITION",$JOB)
+25 KILL ^TMP("SCMSG",$JOB)
+26 QUIT
MAILPOS ;Print POSITION error counts only.
+1 NEW ERROR,NUM,NUM1,POS,TM,TXT
+2 ;
+3 SET NUM=0
+4 ;
FOR
SET NUM=$ORDER(^TMP("PCMM POSITION",$JOB,NUM))
if 'NUM
QUIT
Begin DoDot:1
+5 SET TM=""
+6 ;
FOR
SET TM=$ORDER(^TMP("PCMM POSITION",$JOB,NUM,TM))
if TM=""
QUIT
Begin DoDot:2
+7 SET POS=""
+8 ;
FOR
SET POS=$ORDER(^TMP("PCMM POSITION",$JOB,NUM,TM,POS))
if POS=""
QUIT
Begin DoDot:3
+9 SET ERROR(NUM\1)=($GET(ERROR(NUM\1))+1)
End DoDot:3
End DoDot:2
End DoDot:1
+10 ;
+11 DO SET(" ")
+12 DO SET("POSITION INCONSISTENCIES")
+13 DO SET("------------------------")
+14 DO SET(" ")
+15 IF '$DATA(^TMP("PCMM POSITION",$JOB))
Begin DoDot:1
+16 DO SET("No inconsistencies found.")
End DoDot:1
QUIT
+17 ;
+18 DO SET("Total teams/positions per inconsistency type:")
+19 SET NUM=0
+20 ;
FOR
SET NUM=$ORDER(ERROR(NUM))
if 'NUM
QUIT
Begin DoDot:1
+21 SET NUM1=(NUM\1)
+22 SET TXT=$TEXT(TXT+NUM1^SCRPV1B)
+23 ;W !?3,$P(TXT,";",3)_". "
+24 SET TXT=$PIECE(TXT,";",4)
+25 ;
IF TXT["[]"
Begin DoDot:2
+26 SET TXT=$PIECE(TXT,"[]",1)_"Team Assign/Team/Position"_$PIECE(TXT,"[]",2)
End DoDot:2
+27 DO SET(TXT_" - "_ERROR(NUM1))
End DoDot:1
+28 QUIT
+29 ;
MAILPT ;Print PATIENT error counts only.
+1 NEW DFN,DFNNAM,ERROR,NUM
+2 ;
+3 SET DFNNAM=""
+4 ;
FOR
SET DFNNAM=$ORDER(^TMP("PCMM PATIENT",$JOB,DFNNAM))
if DFNNAM=""
QUIT
Begin DoDot:1
+5 SET DFN=0
+6 ;
FOR
SET DFN=$ORDER(^TMP("PCMM PATIENT",$JOB,DFNNAM,DFN))
if 'DFN
QUIT
Begin DoDot:2
+7 SET NUM=0
+8 ;
FOR
SET NUM=$ORDER(^TMP("PCMM PATIENT",$JOB,DFNNAM,DFN,NUM))
if 'NUM
QUIT
Begin DoDot:3
+9 SET ERROR("PT",NUM\1)=($GET(ERROR("PT",NUM\1))+1)
End DoDot:3
End DoDot:2
End DoDot:1
+10 ;
+11 DO SET(" ")
+12 DO SET("PATIENT INCONSISTENCIES")
+13 DO SET("-----------------------")
+14 DO SET(" ")
+15 IF '$DATA(^TMP("PCMM PATIENT",$JOB))
Begin DoDot:1
+16 DO SET("No inconsistencies found.")
End DoDot:1
QUIT
+17 ;
+18 DO SET("Total patients per inconsistency type:")
+19 SET NUM=0
+20 ;
FOR
SET NUM=$ORDER(ERROR("PT",NUM))
if 'NUM
QUIT
Begin DoDot:1
+21 SET NUM=NUM\1
+22 SET TXT=$TEXT(TXT+NUM^SCRPV1B)
+23 ;W !?3,$P(TXT,";",3)_". "
+24 SET TXT=$PIECE(TXT,";",4)
+25 ;
IF TXT["[]"
Begin DoDot:2
+26 SET TXT=$PIECE(TXT,"[]",1)_"Team Assign/Team/Position"_$PIECE(TXT,"[]",2)
End DoDot:2
+27 DO SET(TXT_" - "_ERROR("PT",NUM))
End DoDot:1
+28 QUIT
+29 ;
SET(TXT) ;Build message array
+1 SET ^TMP("SCMSG",$JOB,CNT)=TXT
+2 SET CNT=CNT+1
+3 QUIT
