source: FOIAVistA/trunk/r/MEDICINE-MC/MCOR.m@ 813

Last change on this file since 813 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1MCOR ;WISC/TJK-OERR/MEDICINE PACKAGE LINKS ;4/2/98 15:28
2 ;;2.3;Medicine;**17**;09/13/1996
3PRINT Q:ORACTION'=8 Q:'$D(GMRCSR) Q:'$D(GMRCPRNM) Q:'$D(^MCAR(697.2,"BA",GMRCPRNM))
4 K ^TMP("MC",$J) S MCFILE=+$P($P(GMRCSR,";",2),"MCAR(",2),MCARGDA=$P(GMRCSR,";"),MCK=0
5 I $G(MCESON),('$$SCRSUMPT^MCESSCR(MCFILE,MCARGDA)) S ^TMP("MC",$J,"S")="This report is not authorized for Release" Q
6 S MCSMR="" S:$D(^MCAR(MCFILE,MCARGDA,.2)) MCSMR=^(.2)
7 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:"")
8 K ^TMP("MC",$J) S ^TMP("MC",$J,"S")=K_U_$P(MCSMR,U,2)
9 S MCARGNUM=$O(^MCAR(697.2,"BA",GMRCPRNM,0))
10 I MCFILE=699 S MCARCODE=$P($G(^MCAR(697.2,MCARGNUM,0)),U,4) D ENDO G EXIT
11 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
12EXIT Q K I,J,K,L,MCFILE,MCARGDA,MCARGNUM,MCSMR,MCM,MCHEAD,MCARCODE,MCFILE1,MCNODE,MCPIECE,MCBRANCH Q
13HEM S MCC="I",MCNODE=12,MCPIECE=1,MCFILE1=694.1,MCHEAD="INDICATION" D MPOINT^MCOREX
14 S MCM=694.058,MCHEAD="INDICATION;W" D WP^MCOREX ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
15 S MCNODE=10,MCPIECE=1,MCFILE1=697.5,MCHEAD="PROVISIONAL DX" D MPOINT^MCOREX
16 S MCNODE=1,MCPIECE=2,MCHEAD="PROVISIONAL DX REMARKS" D FREE^MCOREX
17 S MCC="D",MCNODE=8,MCPIECE=1,MCFILE1=697.5,MCHEAD="FINAL DIAGNOSIS" D MPOINT^MCOREX
18 S MCM=694.041,MCHEAD="FINAL DIAGNOSIS REMARKS;W" D WP^MCOREX ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
19 Q
20RHEUM S MCC="D",MCNODE=5,MCPIECE=52,MCFILE1=329,MCHEAD="DISEASE SEVERITY-PHYS. ESTIMATE" D SETS^MCOREX
21 S MCNODE=13,MCPIECE=1,MCFILE1=697.5,MCHEAD="DIAGNOSIS" D MPOINT^MCOREX
22 Q
23HOLTER S MCC="I",MCNODE=8,MCFILE1=691.65,MCPIECE=1,MCHEAD="REASON FOR STUDY" D MSET^MCOREX
24 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
25 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
26 Q
27ETT S MCC="I",MCNODE=0,MCPIECE=4,MCFILE1=3,MCHEAD="REASON FOR TEST" D SETS^MCOREX
28 S MCC="D",MCNODE=5,MCPIECE=8,MCFILE1=55,MCHEAD="INTERPRETATION" D SETS^MCOREX
29 Q
30EP S MCC="I",MCNODE=5,MCPIECE1=1,MCFILE1=697.5,MCHEAD="ARRHYTHMIA DX" D MPOINT^MCOREX
31 S MCNODE=6,MCPIECE=1,MCHEAD="CARDIAX DX" D POINT^MCOREX
32 S MCC="D",MCM=691.813,MCHEAD="INTERPRETATION;W" D WP^MCOREX ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
33 Q
34ECG S MCC="I",MCNODE=.3,MCPIECE=1,MCFILE1=695.5,MCHEAD="SYMPTOM" D MPOINT^MCOREX
35 S MCNODE=0,MCPIECE=3,MCFILE1=2,MCHEAD="TYPE OF EKG" D SETS^MCOREX
36 S MCC="D",MCNODE=3,MCPIECE=1,MCFILE1=693.3,MCHEAD="INTERPRETATION CODE (RHYTHM)" D MPOINT^MCOREX
37 S MCNODE=5,MCHEAD="INTERPRETATION CODE (CONFIG)" D MPOINT^MCOREX
38 S MCNODE=6,MCHEAD="INTERPRETATION CODE (PACING)" D MPOINT^MCOREX
39 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
40 Q
41ECHO S MCC="I",MCNODE=.3,MCFILE1=691.08,MCPIECE=1,MCHEAD="SYMPTOM" D MSET^MCOREX
42 S MCC="D",MCNODE=9,MCFILE1=693,MCPIECE=1,MCHEAD="FINDINGS" D MPOINT^MCOREX
43 S MCNODE=14,MCFILE1=697.5,MCPIECE=1,MCHEAD="DIAGNOSIS" D MPOINT^MCOREX
44 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
45 Q
46CATH S MCC="I",MCNODE=.3,MCFILE1=695.5,MCPIECE=1,MCHEAD="SYMPTOM" D MPOINT^MCOREX
47 S MCNODE=8,MCFILE1=697.5,MCHEAD="INDICATION" D MPOINT^MCOREX
48 S MCC="D",MCNODE=42,MCFILE1=693.2,MCHEAD="INTERPRETATION" D POINT^MCOREX
49 Q
50PFT S MCC="I",MCNODE=1,MCPIECE=1,MCFILE1=697.5,MCHEAD="CONSULT DX" D MPOINT^MCOREX
51 S MCC="D",MCNODE=24,MCPIECE=1,MCFILE1=693.2,MCHEAD="COMP. GENERATED INTERPRETATION" D MPOINT^MCOREX
52 S MCM=700.04,MCHEAD="FREE TEXT INTERPRETATION;W" D WP^MCOREX ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
53 S MCM=700.03,MCHEAD="COMMENTS AND RECOMMENDATIONS;W" D WP^MCOREX ;CHGD 'SET' TO 'WP^MCOREX' 5-19-92 MLH
54 Q
55ENDO D ENDO^MCOR1
56 Q
57SET S MCK=MCK+1,^TMP("MC",$J,MCC,MCK)=MCM_U_MCHEAD Q
58NOTIFY(MCDA,MCFILE,MCX) Q
59MGMT ;Allows Site Manager to allow hooks to OE/RR.
60 S DIR("A")="Do you want to enable Order Entry/Results Reporting" S DIR(0)="Y" D ^DIR G:$D(DIRUT) MGMTEXIT
61 I Y=1 D
62 . D PARAM^MCU("2///Y") W !,"OE/RR enabled!",!!
63 . Q
64 E D
65 . N MC S MC=$S($P($G(^MCAR(690.1,1,0)),U,3)'="Y":" already ",1:" ")
66 . D PARAM^MCU("2///@")
67 . W !,"OE/RR",MC,"disabled!",!!
68 . Q
69MGMTEXIT ;
70 K X,Y,DIE,DA,DR,DIR
71 Q
Note: See TracBrowser for help on using the repository browser.