- MCOR ;WISC/TJK-OERR/MEDICINE PACKAGE LINKS ;4/2/98 15:28
- ;;2.3;Medicine;**17**;09/13/1996
- PRINT Q:ORACTION'=8 Q:'$D(GMRCSR) Q:'$D(GMRCPRNM) Q:'$D(^MCAR(697.2,"BA",GMRCPRNM))
- K ^TMP("MC",$J) S MCFILE=+$P($P(GMRCSR,";",2),"MCAR(",2),MCARGDA=$P(GMRCSR,";"),MCK=0
- I $G(MCESON),('$$SCRSUMPT^MCESSCR(MCFILE,MCARGDA)) S ^TMP("MC",$J,"S")="This report is not authorized for Release" Q
- S MCSMR="" S:$D(^MCAR(MCFILE,MCARGDA,.2)) MCSMR=^(.2)
- S K=$P(MCSMR,U),K=$S(K="N"!(K="L"):"NORMAL",K="A":"ABNORMAL",K="B":"BORDERLINE",K="T":"TECHNICALLY UNSATISFACTORY",K="ND":"NON-DIAGNOSTIC",K="MI":"MILDLY ABNORMAL",K="MO":"MODERATELY ABNORMAL",K="S":"SEVERELY ABNORMAL",1:"")
- K ^TMP("MC",$J) S ^TMP("MC",$J,"S")=K_U_$P(MCSMR,U,2)
- S MCARGNUM=$O(^MCAR(697.2,"BA",GMRCPRNM,0))
- I MCFILE=699 S MCARCODE=$P($G(^MCAR(697.2,MCARGNUM,0)),U,4) D ENDO G EXIT
- S MCBRANCH=$S(MCFILE=691:"ECHO",MCFILE=691.1:"CATH",MCFILE=691.5:"ECG",MCFILE=691.6:"HOLTER",MCFILE=691.7:"ETT",MCFILE=691.8:"EP",MCFILE=694:"HEM",MCFILE=700:"PFT",MCFILE=701:"RHEUM",1:"^MCOR1") D @MCBRANCH
- EXIT Q K I,J,K,L,MCFILE,MCARGDA,MCARGNUM,MCSMR,MCM,MCHEAD,MCARCODE,MCFILE1,MCNODE,MCPIECE,MCBRANCH Q
- HEM S MCC="I",MCNODE=12,MCPIECE=1,MCFILE1=694.1,MCHEAD="INDICATION" D MPOINT^MCOREX
- S MCM=694.058,MCHEAD="INDICATION;W" D WP^MCOREX ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
- S MCNODE=10,MCPIECE=1,MCFILE1=697.5,MCHEAD="PROVISIONAL DX" D MPOINT^MCOREX
- S MCNODE=1,MCPIECE=2,MCHEAD="PROVISIONAL DX REMARKS" D FREE^MCOREX
- S MCC="D",MCNODE=8,MCPIECE=1,MCFILE1=697.5,MCHEAD="FINAL DIAGNOSIS" D MPOINT^MCOREX
- S MCM=694.041,MCHEAD="FINAL DIAGNOSIS REMARKS;W" D WP^MCOREX ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
- Q
- RHEUM S MCC="D",MCNODE=5,MCPIECE=52,MCFILE1=329,MCHEAD="DISEASE SEVERITY-PHYS. ESTIMATE" D SETS^MCOREX
- S MCNODE=13,MCPIECE=1,MCFILE1=697.5,MCHEAD="DIAGNOSIS" D MPOINT^MCOREX
- Q
- HOLTER S MCC="I",MCNODE=8,MCFILE1=691.65,MCPIECE=1,MCHEAD="REASON FOR STUDY" D MSET^MCOREX
- S MCM=691.68,MCHEAD="OTHER INDICATIONS" D WP^MCOREX ;CHGD 'HEAD=' TO 'MCHEAD=' 5/18/92 MLH, 'SET' TO 'WP^MCOREX' 5/19/92 MLH
- S MCC="D",MCM=691.63,MCHEAD="INTERPRETATION" D WP^MCOREX ;CHGD 'HEAD=' TO 'MCHEAD=' 5/18/92 MLH, 'SET' TO 'WP^MCOREX' 5/19/92 MLH
- Q
- ETT S MCC="I",MCNODE=0,MCPIECE=4,MCFILE1=3,MCHEAD="REASON FOR TEST" D SETS^MCOREX
- S MCC="D",MCNODE=5,MCPIECE=8,MCFILE1=55,MCHEAD="INTERPRETATION" D SETS^MCOREX
- Q
- EP S MCC="I",MCNODE=5,MCPIECE1=1,MCFILE1=697.5,MCHEAD="ARRHYTHMIA DX" D MPOINT^MCOREX
- S MCNODE=6,MCPIECE=1,MCHEAD="CARDIAX DX" D POINT^MCOREX
- S MCC="D",MCM=691.813,MCHEAD="INTERPRETATION;W" D WP^MCOREX ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
- Q
- ECG S MCC="I",MCNODE=.3,MCPIECE=1,MCFILE1=695.5,MCHEAD="SYMPTOM" D MPOINT^MCOREX
- S MCNODE=0,MCPIECE=3,MCFILE1=2,MCHEAD="TYPE OF EKG" D SETS^MCOREX
- S MCC="D",MCNODE=3,MCPIECE=1,MCFILE1=693.3,MCHEAD="INTERPRETATION CODE (RHYTHM)" D MPOINT^MCOREX
- S MCNODE=5,MCHEAD="INTERPRETATION CODE (CONFIG)" D MPOINT^MCOREX
- S MCNODE=6,MCHEAD="INTERPRETATION CODE (PACING)" D MPOINT^MCOREX
- S MCM=691.57,MCHEAD="AUTO-INSTRUMENT DIAGNOSIS" D WP^MCOREX ;CHGD 'HEAD=' TO 'MCHEAD=' 5/18/92 MLH, 'SET' TO 'WP^MCOREX' 5/19/92 MLH
- Q
- ECHO S MCC="I",MCNODE=.3,MCFILE1=691.08,MCPIECE=1,MCHEAD="SYMPTOM" D MSET^MCOREX
- S MCC="D",MCNODE=9,MCFILE1=693,MCPIECE=1,MCHEAD="FINDINGS" D MPOINT^MCOREX
- S MCNODE=14,MCFILE1=697.5,MCPIECE=1,MCHEAD="DIAGNOSIS" D MPOINT^MCOREX
- S MCM=691.07,MCHEAD="OTHER CONCLUSION" D WP^MCOREX ;CHGD 'HEAD=' TO 'MCHEAD=' 5/18/92 MLH, 'SET' TO 'WP^MCOREX' 5/19/92 MLH
- Q
- CATH S MCC="I",MCNODE=.3,MCFILE1=695.5,MCPIECE=1,MCHEAD="SYMPTOM" D MPOINT^MCOREX
- S MCNODE=8,MCFILE1=697.5,MCHEAD="INDICATION" D MPOINT^MCOREX
- S MCC="D",MCNODE=42,MCFILE1=693.2,MCHEAD="INTERPRETATION" D POINT^MCOREX
- Q
- PFT S MCC="I",MCNODE=1,MCPIECE=1,MCFILE1=697.5,MCHEAD="CONSULT DX" D MPOINT^MCOREX
- S MCC="D",MCNODE=24,MCPIECE=1,MCFILE1=693.2,MCHEAD="COMP. GENERATED INTERPRETATION" D MPOINT^MCOREX
- S MCM=700.04,MCHEAD="FREE TEXT INTERPRETATION;W" D WP^MCOREX ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
- S MCM=700.03,MCHEAD="COMMENTS AND RECOMMENDATIONS;W" D WP^MCOREX ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
- Q
- ENDO D ENDO^MCOR1
- Q
- SET S MCK=MCK+1,^TMP("MC",$J,MCC,MCK)=MCM_U_MCHEAD Q
- NOTIFY(MCDA,MCFILE,MCX) Q
- MGMT ;Allows Site Manager to allow hooks to OE/RR.
- S DIR("A")="Do you want to enable Order Entry/Results Reporting" S DIR(0)="Y" D ^DIR G:$D(DIRUT) MGMTEXIT
- I Y=1 D
- . D PARAM^MCU("2///Y") W !,"OE/RR enabled!",!!
- . Q
- E D
- . N MC S MC=$S($P($G(^MCAR(690.1,1,0)),U,3)'="Y":" already ",1:" ")
- . D PARAM^MCU("2///@")
- . W !,"OE/RR",MC,"disabled!",!!
- . Q
- MGMTEXIT ;
- K X,Y,DIE,DA,DR,DIR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCOR 4644 printed Feb 18, 2025@23:42:16 Page 2
- MCOR ;WISC/TJK-OERR/MEDICINE PACKAGE LINKS ;4/2/98 15:28
- +1 ;;2.3;Medicine;**17**;09/13/1996
- PRINT if ORACTION'=8
- QUIT
- if '$DATA(GMRCSR)
- QUIT
- if '$DATA(GMRCPRNM)
- QUIT
- if '$DATA(^MCAR(697.2,"BA",GMRCPRNM))
- QUIT
- +1 KILL ^TMP("MC",$JOB)
- SET MCFILE=+$PIECE($PIECE(GMRCSR,";",2),"MCAR(",2)
- SET MCARGDA=$PIECE(GMRCSR,";")
- SET MCK=0
- +2 IF $GET(MCESON)
- IF ('$$SCRSUMPT^MCESSCR(MCFILE,MCARGDA))
- SET ^TMP("MC",$JOB,"S")="This report is not authorized for Release"
- QUIT
- +3 SET MCSMR=""
- if $DATA(^MCAR(MCFILE,MCARGDA,.2))
- SET MCSMR=^(.2)
- +4 SET K=$PIECE(MCSMR,U)
- SET K=$SELECT(K="N"!(K="L"):"NORMAL",K="A":"ABNORMAL",K="B":"BORDERLINE",K="T":"TECHNICALLY UNSATISFACTORY",K="ND":"NON-DIAGNOSTIC",K="MI":"MILDLY ABNORMAL",K="MO":"MODERATELY ABNORMAL",K="S":"SEVERELY ABNORMAL",1:"")
- +5 KILL ^TMP("MC",$JOB)
- SET ^TMP("MC",$JOB,"S")=K_U_$PIECE(MCSMR,U,2)
- +6 SET MCARGNUM=$ORDER(^MCAR(697.2,"BA",GMRCPRNM,0))
- +7 IF MCFILE=699
- SET MCARCODE=$PIECE($GET(^MCAR(697.2,MCARGNUM,0)),U,4)
- DO ENDO
- GOTO EXIT
- +8 SET MCBRANCH=$SELECT(MCFILE=691:"ECHO",MCFILE=691.1:"CATH",MCFILE=691.5:"ECG",MCFILE=691.6:"HOLTER",MCFILE=691.7:"ETT",MCFILE=691.8:"EP",MCFILE=694:"HEM",MCFILE=700:"PFT",MCFILE=701:"RHEUM",1:"^MCOR1")
- DO @MCBRANCH
- EXIT QUIT
- KILL I,J,K,L,MCFILE,MCARGDA,MCARGNUM,MCSMR,MCM,MCHEAD,MCARCODE,MCFILE1,MCNODE,MCPIECE,MCBRANCH
- QUIT
- HEM SET MCC="I"
- SET MCNODE=12
- SET MCPIECE=1
- SET MCFILE1=694.1
- SET MCHEAD="INDICATION"
- DO MPOINT^MCOREX
- +1 ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
- SET MCM=694.058
- SET MCHEAD="INDICATION;W"
- DO WP^MCOREX
- +2 SET MCNODE=10
- SET MCPIECE=1
- SET MCFILE1=697.5
- SET MCHEAD="PROVISIONAL DX"
- DO MPOINT^MCOREX
- +3 SET MCNODE=1
- SET MCPIECE=2
- SET MCHEAD="PROVISIONAL DX REMARKS"
- DO FREE^MCOREX
- +4 SET MCC="D"
- SET MCNODE=8
- SET MCPIECE=1
- SET MCFILE1=697.5
- SET MCHEAD="FINAL DIAGNOSIS"
- DO MPOINT^MCOREX
- +5 ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
- SET MCM=694.041
- SET MCHEAD="FINAL DIAGNOSIS REMARKS;W"
- DO WP^MCOREX
- +6 QUIT
- RHEUM SET MCC="D"
- SET MCNODE=5
- SET MCPIECE=52
- SET MCFILE1=329
- SET MCHEAD="DISEASE SEVERITY-PHYS. ESTIMATE"
- DO SETS^MCOREX
- +1 SET MCNODE=13
- SET MCPIECE=1
- SET MCFILE1=697.5
- SET MCHEAD="DIAGNOSIS"
- DO MPOINT^MCOREX
- +2 QUIT
- HOLTER SET MCC="I"
- SET MCNODE=8
- SET MCFILE1=691.65
- SET MCPIECE=1
- SET MCHEAD="REASON FOR STUDY"
- DO MSET^MCOREX
- +1 ;CHGD 'HEAD=' TO 'MCHEAD=' 5/18/92 MLH, 'SET' TO 'WP^MCOREX' 5/19/92 MLH
- SET MCM=691.68
- SET MCHEAD="OTHER INDICATIONS"
- DO WP^MCOREX
- +2 ;CHGD 'HEAD=' TO 'MCHEAD=' 5/18/92 MLH, 'SET' TO 'WP^MCOREX' 5/19/92 MLH
- SET MCC="D"
- SET MCM=691.63
- SET MCHEAD="INTERPRETATION"
- DO WP^MCOREX
- +3 QUIT
- ETT SET MCC="I"
- SET MCNODE=0
- SET MCPIECE=4
- SET MCFILE1=3
- SET MCHEAD="REASON FOR TEST"
- DO SETS^MCOREX
- +1 SET MCC="D"
- SET MCNODE=5
- SET MCPIECE=8
- SET MCFILE1=55
- SET MCHEAD="INTERPRETATION"
- DO SETS^MCOREX
- +2 QUIT
- EP SET MCC="I"
- SET MCNODE=5
- SET MCPIECE1=1
- SET MCFILE1=697.5
- SET MCHEAD="ARRHYTHMIA DX"
- DO MPOINT^MCOREX
- +1 SET MCNODE=6
- SET MCPIECE=1
- SET MCHEAD="CARDIAX DX"
- DO POINT^MCOREX
- +2 ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
- SET MCC="D"
- SET MCM=691.813
- SET MCHEAD="INTERPRETATION;W"
- DO WP^MCOREX
- +3 QUIT
- ECG SET MCC="I"
- SET MCNODE=.3
- SET MCPIECE=1
- SET MCFILE1=695.5
- SET MCHEAD="SYMPTOM"
- DO MPOINT^MCOREX
- +1 SET MCNODE=0
- SET MCPIECE=3
- SET MCFILE1=2
- SET MCHEAD="TYPE OF EKG"
- DO SETS^MCOREX
- +2 SET MCC="D"
- SET MCNODE=3
- SET MCPIECE=1
- SET MCFILE1=693.3
- SET MCHEAD="INTERPRETATION CODE (RHYTHM)"
- DO MPOINT^MCOREX
- +3 SET MCNODE=5
- SET MCHEAD="INTERPRETATION CODE (CONFIG)"
- DO MPOINT^MCOREX
- +4 SET MCNODE=6
- SET MCHEAD="INTERPRETATION CODE (PACING)"
- DO MPOINT^MCOREX
- +5 ;CHGD 'HEAD=' TO 'MCHEAD=' 5/18/92 MLH, 'SET' TO 'WP^MCOREX' 5/19/92 MLH
- SET MCM=691.57
- SET MCHEAD="AUTO-INSTRUMENT DIAGNOSIS"
- DO WP^MCOREX
- +6 QUIT
- ECHO SET MCC="I"
- SET MCNODE=.3
- SET MCFILE1=691.08
- SET MCPIECE=1
- SET MCHEAD="SYMPTOM"
- DO MSET^MCOREX
- +1 SET MCC="D"
- SET MCNODE=9
- SET MCFILE1=693
- SET MCPIECE=1
- SET MCHEAD="FINDINGS"
- DO MPOINT^MCOREX
- +2 SET MCNODE=14
- SET MCFILE1=697.5
- SET MCPIECE=1
- SET MCHEAD="DIAGNOSIS"
- DO MPOINT^MCOREX
- +3 ;CHGD 'HEAD=' TO 'MCHEAD=' 5/18/92 MLH, 'SET' TO 'WP^MCOREX' 5/19/92 MLH
- SET MCM=691.07
- SET MCHEAD="OTHER CONCLUSION"
- DO WP^MCOREX
- +4 QUIT
- CATH SET MCC="I"
- SET MCNODE=.3
- SET MCFILE1=695.5
- SET MCPIECE=1
- SET MCHEAD="SYMPTOM"
- DO MPOINT^MCOREX
- +1 SET MCNODE=8
- SET MCFILE1=697.5
- SET MCHEAD="INDICATION"
- DO MPOINT^MCOREX
- +2 SET MCC="D"
- SET MCNODE=42
- SET MCFILE1=693.2
- SET MCHEAD="INTERPRETATION"
- DO POINT^MCOREX
- +3 QUIT
- PFT SET MCC="I"
- SET MCNODE=1
- SET MCPIECE=1
- SET MCFILE1=697.5
- SET MCHEAD="CONSULT DX"
- DO MPOINT^MCOREX
- +1 SET MCC="D"
- SET MCNODE=24
- SET MCPIECE=1
- SET MCFILE1=693.2
- SET MCHEAD="COMP. GENERATED INTERPRETATION"
- DO MPOINT^MCOREX
- +2 ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
- SET MCM=700.04
- SET MCHEAD="FREE TEXT INTERPRETATION;W"
- DO WP^MCOREX
- +3 ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
- SET MCM=700.03
- SET MCHEAD="COMMENTS AND RECOMMENDATIONS;W"
- DO WP^MCOREX
- +4 QUIT
- ENDO DO ENDO^MCOR1
- +1 QUIT
- SET SET MCK=MCK+1
- SET ^TMP("MC",$JOB,MCC,MCK)=MCM_U_MCHEAD
- QUIT
- NOTIFY(MCDA,MCFILE,MCX) QUIT
- MGMT ;Allows Site Manager to allow hooks to OE/RR.
- +1 SET DIR("A")="Do you want to enable Order Entry/Results Reporting"
- SET DIR(0)="Y"
- DO ^DIR
- if $DATA(DIRUT)
- GOTO MGMTEXIT
- +2 IF Y=1
- Begin DoDot:1
- +3 DO PARAM^MCU("2///Y")
- WRITE !,"OE/RR enabled!",!!
- +4 QUIT
- End DoDot:1
- +5 IF '$TEST
- Begin DoDot:1
- +6 NEW MC
- SET MC=$SELECT($PIECE($GET(^MCAR(690.1,1,0)),U,3)'="Y":" already ",1:" ")
- +7 DO PARAM^MCU("2///@")
- +8 WRITE !,"OE/RR",MC,"disabled!",!!
- +9 QUIT
- End DoDot:1
- MGMTEXIT ;
- +1 KILL X,Y,DIE,DA,DR,DIR
- +2 QUIT