217 lines
5.6 KiB
Mathematica
217 lines
5.6 KiB
Mathematica
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
|