source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPV1.m@ 1397

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