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 Oct 16, 2024@18:16:25 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
