- 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 Feb 18, 2025@23:42:17 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
