Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MCOR

MCOR.m

Go to the documentation of this file.
  1. MCOR ;WISC/TJK-OERR/MEDICINE PACKAGE LINKS ;4/2/98 15:28
  1. ;;2.3;Medicine;**17**;09/13/1996
  1. PRINT Q:ORACTION'=8 Q:'$D(GMRCSR) Q:'$D(GMRCPRNM) Q:'$D(^MCAR(697.2,"BA",GMRCPRNM))
  1. K ^TMP("MC",$J) S MCFILE=+$P($P(GMRCSR,";",2),"MCAR(",2),MCARGDA=$P(GMRCSR,";"),MCK=0
  1. I $G(MCESON),('$$SCRSUMPT^MCESSCR(MCFILE,MCARGDA)) S ^TMP("MC",$J,"S")="This report is not authorized for Release" Q
  1. S MCSMR="" S:$D(^MCAR(MCFILE,MCARGDA,.2)) MCSMR=^(.2)
  1. 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:"")
  1. K ^TMP("MC",$J) S ^TMP("MC",$J,"S")=K_U_$P(MCSMR,U,2)
  1. S MCARGNUM=$O(^MCAR(697.2,"BA",GMRCPRNM,0))
  1. I MCFILE=699 S MCARCODE=$P($G(^MCAR(697.2,MCARGNUM,0)),U,4) D ENDO G EXIT
  1. 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
  1. EXIT Q K I,J,K,L,MCFILE,MCARGDA,MCARGNUM,MCSMR,MCM,MCHEAD,MCARCODE,MCFILE1,MCNODE,MCPIECE,MCBRANCH Q
  1. HEM S MCC="I",MCNODE=12,MCPIECE=1,MCFILE1=694.1,MCHEAD="INDICATION" D MPOINT^MCOREX
  1. S MCM=694.058,MCHEAD="INDICATION;W" D WP^MCOREX ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
  1. S MCNODE=10,MCPIECE=1,MCFILE1=697.5,MCHEAD="PROVISIONAL DX" D MPOINT^MCOREX
  1. S MCNODE=1,MCPIECE=2,MCHEAD="PROVISIONAL DX REMARKS" D FREE^MCOREX
  1. S MCC="D",MCNODE=8,MCPIECE=1,MCFILE1=697.5,MCHEAD="FINAL DIAGNOSIS" D MPOINT^MCOREX
  1. S MCM=694.041,MCHEAD="FINAL DIAGNOSIS REMARKS;W" D WP^MCOREX ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
  1. Q
  1. RHEUM S MCC="D",MCNODE=5,MCPIECE=52,MCFILE1=329,MCHEAD="DISEASE SEVERITY-PHYS. ESTIMATE" D SETS^MCOREX
  1. S MCNODE=13,MCPIECE=1,MCFILE1=697.5,MCHEAD="DIAGNOSIS" D MPOINT^MCOREX
  1. Q
  1. HOLTER S MCC="I",MCNODE=8,MCFILE1=691.65,MCPIECE=1,MCHEAD="REASON FOR STUDY" D MSET^MCOREX
  1. 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
  1. 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
  1. Q
  1. ETT S MCC="I",MCNODE=0,MCPIECE=4,MCFILE1=3,MCHEAD="REASON FOR TEST" D SETS^MCOREX
  1. S MCC="D",MCNODE=5,MCPIECE=8,MCFILE1=55,MCHEAD="INTERPRETATION" D SETS^MCOREX
  1. Q
  1. EP S MCC="I",MCNODE=5,MCPIECE1=1,MCFILE1=697.5,MCHEAD="ARRHYTHMIA DX" D MPOINT^MCOREX
  1. S MCNODE=6,MCPIECE=1,MCHEAD="CARDIAX DX" D POINT^MCOREX
  1. S MCC="D",MCM=691.813,MCHEAD="INTERPRETATION;W" D WP^MCOREX ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
  1. Q
  1. ECG S MCC="I",MCNODE=.3,MCPIECE=1,MCFILE1=695.5,MCHEAD="SYMPTOM" D MPOINT^MCOREX
  1. S MCNODE=0,MCPIECE=3,MCFILE1=2,MCHEAD="TYPE OF EKG" D SETS^MCOREX
  1. S MCC="D",MCNODE=3,MCPIECE=1,MCFILE1=693.3,MCHEAD="INTERPRETATION CODE (RHYTHM)" D MPOINT^MCOREX
  1. S MCNODE=5,MCHEAD="INTERPRETATION CODE (CONFIG)" D MPOINT^MCOREX
  1. S MCNODE=6,MCHEAD="INTERPRETATION CODE (PACING)" D MPOINT^MCOREX
  1. 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
  1. Q
  1. ECHO S MCC="I",MCNODE=.3,MCFILE1=691.08,MCPIECE=1,MCHEAD="SYMPTOM" D MSET^MCOREX
  1. S MCC="D",MCNODE=9,MCFILE1=693,MCPIECE=1,MCHEAD="FINDINGS" D MPOINT^MCOREX
  1. S MCNODE=14,MCFILE1=697.5,MCPIECE=1,MCHEAD="DIAGNOSIS" D MPOINT^MCOREX
  1. 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
  1. Q
  1. CATH S MCC="I",MCNODE=.3,MCFILE1=695.5,MCPIECE=1,MCHEAD="SYMPTOM" D MPOINT^MCOREX
  1. S MCNODE=8,MCFILE1=697.5,MCHEAD="INDICATION" D MPOINT^MCOREX
  1. S MCC="D",MCNODE=42,MCFILE1=693.2,MCHEAD="INTERPRETATION" D POINT^MCOREX
  1. Q
  1. PFT S MCC="I",MCNODE=1,MCPIECE=1,MCFILE1=697.5,MCHEAD="CONSULT DX" D MPOINT^MCOREX
  1. S MCC="D",MCNODE=24,MCPIECE=1,MCFILE1=693.2,MCHEAD="COMP. GENERATED INTERPRETATION" D MPOINT^MCOREX
  1. S MCM=700.04,MCHEAD="FREE TEXT INTERPRETATION;W" D WP^MCOREX ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
  1. S MCM=700.03,MCHEAD="COMMENTS AND RECOMMENDATIONS;W" D WP^MCOREX ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
  1. Q
  1. ENDO D ENDO^MCOR1
  1. Q
  1. SET S MCK=MCK+1,^TMP("MC",$J,MCC,MCK)=MCM_U_MCHEAD Q
  1. NOTIFY(MCDA,MCFILE,MCX) Q
  1. MGMT ;Allows Site Manager to allow hooks to OE/RR.
  1. S DIR("A")="Do you want to enable Order Entry/Results Reporting" S DIR(0)="Y" D ^DIR G:$D(DIRUT) MGMTEXIT
  1. I Y=1 D
  1. . D PARAM^MCU("2///Y") W !,"OE/RR enabled!",!!
  1. . Q
  1. E D
  1. . N MC S MC=$S($P($G(^MCAR(690.1,1,0)),U,3)'="Y":" already ",1:" ")
  1. . D PARAM^MCU("2///@")
  1. . W !,"OE/RR",MC,"disabled!",!!
  1. . Q
  1. MGMTEXIT ;
  1. K X,Y,DIE,DA,DR,DIR
  1. Q