MCOR1 ;WISC/TJK-OERR/MEDICINE PACKAGE LINKS (PART 2) ;4/27/98 15:20
;;2.3;Medicine;**17,18**;09/13/1996
S MCBRANCH=$S(MCFILE=698.3:"SURV",MCFILE=699.5:"GEN",1:"PACE") D @MCBRANCH
EXIT Q
SET S MCK=MCK+1,^TMP("MC",$J,MCC,MCK)=MCM_U_MCHEAD Q
GEN ;
W !!,"Full Generalized Procedure report not available through Consults."
W !,"See the 'Generalized Procedure Report' option."
S MCK=0
S MCC="D",MCNODE=0,MCPIECE=8,MCFILE1=697.2,MCHEAD="PROCEDURE" D POINT^MCOREX
S MCC="D",MCNODE=0,MCPIECE=6,MCFILE1=697.2,MCHEAD="SUBSPECIALTY" D POINT^MCOREX
S MCC="D",MCM=699.534,MCHEAD="ASSESSMENT/FINDINGS;W" D WP^MCOREX
Q
PACE ;
S MCC="D",MCNODE=0,MCPIECE=3,MCFILE1=698.4
S MCARCODE=$S(MCFILE=698:"PACEMAKER",MCFILE=698.1:"V LEAD",MCFILE=698.2:"A LEAD",1:"")
I MCARCODE="" W !!,"Full Procedure report not available through Consults." Q
S MCHEAD=MCARCODE_" MODEL" D POINT^MCOREX
S MCPIECE=4,MCFILE1=698.6,MCHEAD=MCARCODE_" MANUFACTURER" D POINT^MCOREX
S MCPIECE=5,MCHEAD=MCARCODE_" SERIAL NUMBER" D FREE^MCOREX
Q
SURV S MCC="D",MCNODE=4,MCPIECE=4,MCHEAD="FOLLOWUP COMMENT" D FREE^MCOREX
S MCM=698.31,MCHEAD="COMMENTS;W" D SET
Q
ENDO S MCC="I",MCNODE=2,MCFILE1=699.6,MCPIECE=1,MCHEAD="INDICATED THERAPY" D MPOINT^MCOREX
S MCNODE=3,MCFILE1=695.5,MCHEAD="SIGNS AND SYMPTOMS" D MPOINT^MCOREX
S MCNODE=5,MCFILE1=699.84,MCHEAD="DISEASE "_$S(MCARCODE="G":"FOLLOWUP",1:"EVALUATION") D MPOINT^MCOREX
S MCNODE=6,MCFILE1=699.85,MCHEAD="FOLLOWUP DEVICE OR THERAPY" D MPOINT^MCOREX
I MCARCODE="P" S MCNODE=12,MCPIECE=1,MCHEAD="OTHER FOLLOWUP DEVICE/THERAPY" D FREE^MCOREX
S MCNODE=7,MCFILE1=699.86,MCHEAD="SURVEILLANCE" D MPOINT^MCOREX
I MCARCODE="G" S MCNODE=31 F MCPIECE=1,2,3 S MCHEAD=$S(MCPIECE=1:"PROTOCOL",MCPIECE=2:"EGD SIMPLE PRIMARY EXAM",1:"LAB OR XRAY") D FREE^MCOREX
I MCARCODE="G" S MCNODE=32 F MCPIECE=1,2 S MCHEAD=$S(MCPIECE=1:"OCCULT BLOOD",1:"SPECIMEN COLLECTION") D FREE^MCOREX
S MCNODE=0,MCPIECE=6,MCHEAD="INDICATION COMMENT" D FREE^MCOREX
S MCC="D",MCNODE=204,MCPIECE=1,MCFILE1=697.5,MCHEAD="PRIMARY DIAGNOSIS" D POINT^MCOREX
S MCNODE=205,MCPIECE=1,MCHEAD="PRIMARY DIAGNOSIS IMPRESSION" D FREE^MCOREX
S MCNODE=27,MCFILE1=697.5,MCPIECE=1,MCHEAD="SECONDARY DIAGNOSIS" D MPOINT^MCOREX
S MCPIECE=2,MCHEAD="SECONDARY DIAGNOSIS IMPRESSION" D MFREE^MCOREX
S MCNODE=19 F MCPIECE=1,2,MCHEAD=$S(MCPIECE=1:"DIAGNOSIS/DIAGNOSIS SUPPLEMENT",1:"REVISED DIAGNOSIS") D FREE^MCOREX
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCOR1 2426 printed Dec 13, 2024@02:15:49 Page 2
MCOR1 ;WISC/TJK-OERR/MEDICINE PACKAGE LINKS (PART 2) ;4/27/98 15:20
+1 ;;2.3;Medicine;**17,18**;09/13/1996
+2 SET MCBRANCH=$SELECT(MCFILE=698.3:"SURV",MCFILE=699.5:"GEN",1:"PACE")
DO @MCBRANCH
EXIT QUIT
SET SET MCK=MCK+1
SET ^TMP("MC",$JOB,MCC,MCK)=MCM_U_MCHEAD
QUIT
GEN ;
+1 WRITE !!,"Full Generalized Procedure report not available through Consults."
+2 WRITE !,"See the 'Generalized Procedure Report' option."
+3 SET MCK=0
+4 SET MCC="D"
SET MCNODE=0
SET MCPIECE=8
SET MCFILE1=697.2
SET MCHEAD="PROCEDURE"
DO POINT^MCOREX
+5 SET MCC="D"
SET MCNODE=0
SET MCPIECE=6
SET MCFILE1=697.2
SET MCHEAD="SUBSPECIALTY"
DO POINT^MCOREX
+6 SET MCC="D"
SET MCM=699.534
SET MCHEAD="ASSESSMENT/FINDINGS;W"
DO WP^MCOREX
+7 QUIT
PACE ;
+1 SET MCC="D"
SET MCNODE=0
SET MCPIECE=3
SET MCFILE1=698.4
+2 SET MCARCODE=$SELECT(MCFILE=698:"PACEMAKER",MCFILE=698.1:"V LEAD",MCFILE=698.2:"A LEAD",1:"")
+3 IF MCARCODE=""
WRITE !!,"Full Procedure report not available through Consults."
QUIT
+4 SET MCHEAD=MCARCODE_" MODEL"
DO POINT^MCOREX
+5 SET MCPIECE=4
SET MCFILE1=698.6
SET MCHEAD=MCARCODE_" MANUFACTURER"
DO POINT^MCOREX
+6 SET MCPIECE=5
SET MCHEAD=MCARCODE_" SERIAL NUMBER"
DO FREE^MCOREX
+7 QUIT
SURV SET MCC="D"
SET MCNODE=4
SET MCPIECE=4
SET MCHEAD="FOLLOWUP COMMENT"
DO FREE^MCOREX
+1 SET MCM=698.31
SET MCHEAD="COMMENTS;W"
DO SET
+2 QUIT
ENDO SET MCC="I"
SET MCNODE=2
SET MCFILE1=699.6
SET MCPIECE=1
SET MCHEAD="INDICATED THERAPY"
DO MPOINT^MCOREX
+1 SET MCNODE=3
SET MCFILE1=695.5
SET MCHEAD="SIGNS AND SYMPTOMS"
DO MPOINT^MCOREX
+2 SET MCNODE=5
SET MCFILE1=699.84
SET MCHEAD="DISEASE "_$SELECT(MCARCODE="G":"FOLLOWUP",1:"EVALUATION")
DO MPOINT^MCOREX
+3 SET MCNODE=6
SET MCFILE1=699.85
SET MCHEAD="FOLLOWUP DEVICE OR THERAPY"
DO MPOINT^MCOREX
+4 IF MCARCODE="P"
SET MCNODE=12
SET MCPIECE=1
SET MCHEAD="OTHER FOLLOWUP DEVICE/THERAPY"
DO FREE^MCOREX
+5 SET MCNODE=7
SET MCFILE1=699.86
SET MCHEAD="SURVEILLANCE"
DO MPOINT^MCOREX
+6 IF MCARCODE="G"
SET MCNODE=31
FOR MCPIECE=1,2,3
SET MCHEAD=$SELECT(MCPIECE=1:"PROTOCOL",MCPIECE=2:"EGD SIMPLE PRIMARY EXAM",1:"LAB OR XRAY")
DO FREE^MCOREX
+7 IF MCARCODE="G"
SET MCNODE=32
FOR MCPIECE=1,2
SET MCHEAD=$SELECT(MCPIECE=1:"OCCULT BLOOD",1:"SPECIMEN COLLECTION")
DO FREE^MCOREX
+8 SET MCNODE=0
SET MCPIECE=6
SET MCHEAD="INDICATION COMMENT"
DO FREE^MCOREX
+9 SET MCC="D"
SET MCNODE=204
SET MCPIECE=1
SET MCFILE1=697.5
SET MCHEAD="PRIMARY DIAGNOSIS"
DO POINT^MCOREX
+10 SET MCNODE=205
SET MCPIECE=1
SET MCHEAD="PRIMARY DIAGNOSIS IMPRESSION"
DO FREE^MCOREX
+11 SET MCNODE=27
SET MCFILE1=697.5
SET MCPIECE=1
SET MCHEAD="SECONDARY DIAGNOSIS"
DO MPOINT^MCOREX
+12 SET MCPIECE=2
SET MCHEAD="SECONDARY DIAGNOSIS IMPRESSION"
DO MFREE^MCOREX
+13 SET MCNODE=19
FOR MCPIECE=1,2,MCHEAD=$SELECT(MCPIECE=1:"DIAGNOSIS/DIAGNOSIS SUPPLEMENT",1:"REVISED DIAGNOSIS")
DO FREE^MCOREX
+14 QUIT
