- 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 Mar 13, 2025@21:48:06 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
