source: FOIAVistA/tag/r/MEDICINE-MC/MCOR.m@ 628

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