Changeset 623 for WorldVistAEHR/trunk/r/SURGERY-SR/SROACMP1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SURGERY-SR/SROACMP1.m
r613 r623 1 SROACMP1 ;BIR/ADM - M&M VERIFICATION REPORT (CONT'D) ;11/26/07 2 ;;3.0; Surgery ;**47,68,77,50,166**;24 Jun 93;Build 7 3 EN ; entry point 4 S (SRSOUT,SRSP)=0,SRINST=$P($$SITE^SROVAR,"^",2) W @IOF,!,?28,"M&M Verification Report" 5 W !!,"The M&M Verification Report is a tool to assist in the review of occurrences" 6 W !,"and their assignment to operations and in the review of death unrelated or",!,"related assignments to operations." 7 W !!,"The full report includes all patients who had operations within the selected" 8 W !,"date range who experienced intraoperative occurrences, postoperative" 9 W !,"occurrences or death within 90 days of surgery. The pre-transmission report" 10 W !,"is similar but includes only operations with completed risk assessments that" 11 W !,"have not yet transmitted to the national database.",! 12 D SEL G:SRSOUT END I SRFORM=2 G SPEC 13 D DATE^SROUTL(.SRSD,.SRED,.SRSOUT) G:SRSOUT END 14 SPEC I $D(^XUSEC("SROCHIEF",+DUZ)) N SRINSTP S SRINST=$$INST^SROUTL0() G:SRINST="^" END S SRINSTP=$P(SRINST,U),SRINST=$S(SRINST["ALL DIVISIONS":SRINST,1:$P(SRINST,U,2)) 15 W !! K DIR S DIR("A")="Do you want to print this report for all Surgical Specialties ",DIR("B")="YES",DIR(0)="Y" 16 S DIR("?",1)="Enter RETURN to print this report for all surgical specialties, or 'NO' to",DIR("?")="select a specific specialty." 17 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 G END 18 I 'Y D SP I SRSOUT G END 19 DEV K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Print the Report on which Device: ",%ZIS="QM" W !!,"This report is designed to use a 132 column format.",! D ^%ZIS I POP S SRSOUT=1 G END 20 I $D(IO("Q")) K IO("Q") S ZTDESC="M&M Verification Report",ZTRTN="BEG^SROACMP1",(ZTSAVE("SRFORM"),ZTSAVE("SRINST"),ZTSAVE("SRSP*"),ZTSAVE("SRINSTP"))="" S:SRFORM=1 (ZTSAVE("SRED"),ZTSAVE("SRSD"))="" D ^%ZTLOAD G END 21 BEG U IO S (SRHDR,SRNM,SRSOUT,SRSS)=0,PAGE=1,Y=DT X ^DD("DD") S SRPRINT="Report Generated: "_Y K ^TMP("SR",$J),^TMP("SRPAT",$J) 22 N SRFRTO I SRFORM=1 D 23 .S Y=SRSD X ^DD("DD") S SRFRTO="From: "_Y S Y=SRED X ^DD("DD") S SRFRTO=SRFRTO_" To: "_Y 24 .S SRSDT=SRSD-.0001,SREDT=SRED+.9999 F S SRSDT=$O(^SRF("AC",SRSDT)) Q:SRSDT>SREDT!'SRSDT!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDT,SRTN)) Q:'SRTN!SRSOUT D CASE 25 I SRFORM=2 F SRASS="C","N" S DFN=0 F S DFN=$O(^SRF("ARS",SRASS,"C",DFN)) Q:'DFN!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("ARS",SRASS,"C",DFN,SRTN)) Q:'SRTN!SRSOUT D CASE 26 G:SRSOUT END G ^SROACMP 27 CASE ; examine case 28 Q:'$D(^SRF(SRTN,0)) 29 I $D(^XUSEC("SROCHIEF",+DUZ)) Q:'$$MANDIV^SROUTL0(SRINSTP,SRTN) 30 I '$D(^XUSEC("SROCHIEF",+DUZ)) Q:'$$DIV^SROUTL0(SRTN) 31 I SRFORM=2,SRSP S Y=$P(^SRF(SRTN,0),"^",4) S:'Y Y="ZZ" I '$D(SRSP(Y)) Q 32 I '$P($G(^SRF(SRTN,.2)),"^",12)!$P($G(^SRF(SRTN,30)),"^")!($P($G(^SRF(SRTN,"NON")),"^")="Y") Q 33 S DFN=$P(^SRF(SRTN,0),"^") I $O(^SRF(SRTN,10,0))!$O(^SRF(SRTN,16,0)) S ^TMP("SR",$J,DFN,SRTN)=$P(^SRF(SRTN,0),"^",4) Q 34 S SRDEATH=$P($G(^DPT(DFN,.35)),"^") I SRDEATH S X1=$P(^SRF(SRTN,0),"^",9),X2=90 D C^%DTC S SRDAY=X I SRDEATH'>SRDAY S ^TMP("SR",$J,DFN,SRTN)=$P(^SRF(SRTN,0),"^",4) 35 Q 36 END Q:'$D(SRSOUT) W @IOF K ^TMP("SRPAT",$J),^TMP("SRSP",$J) I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP) S ZTREQ="@" Q 37 D ^%ZISC,^SRSKILL K SRTN W @IOF 38 Q 39 SEL ; select report version 40 K DIR S DIR("A",1)="Print which report ?",DIR("A",2)=" ",DIR("A",3)="1. Full report for selected date range.",DIR("A",4)="2. Pre-transmission report for completed risk assessments." 41 S DIR("A",5)=" ",DIR("A")="Enter selection (1 or 2): ",DIR("B")=1,DIR("?")="Please enter the number (1 or 2) matching your choice of report",DIR(0)="NA^1:2" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q 42 S SRFORM=Y 43 Q 44 SP W !! S SRSP=1 K DIC S DIC("S")="I '$P(^(0),""^"",3)",DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Print the report for which Specialty ? " D ^DIC I Y<0 S SRSOUT=1 Q 45 S SRCT=+Y,SRSP(SRCT)=+Y 46 MORE ; ask for more surgical specialties 47 K DIC S DIC("S")="I '$P(^(0),""^"",3)",DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Select an Additional Specialty: " D ^DIC I Y>0 S SRCT=+Y,SRSP(SRCT)=+Y G MORE 48 Q 49 HDR ; print heading 50 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q 51 I SRHDR D HDR2 Q:SRSOUT S SRHDR=0 52 W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,?124,"Page ",PAGE,!,?54,"M&M Verification Report" 53 W:SRFORM=1 !,?(132-$L(SRFRTO)\2),SRFRTO 54 W:SRFORM=2 !,?41,"PRE-TRANSMISSION REPORT FOR COMPLETED ASSESSMENTS" 55 W ?100,"REVIEWED BY:",!,?(132-$L(SRPRINT)\2),SRPRINT,?100,"DATE REVIEWED:",! 56 W !,"OP DATE",?11,"CASE #",?25,"SURGICAL SPECIALTY",?80,"ASSESSMENT TYPE STATUS",?116,"DEATH RELATED",!,?11,"PRINCIPAL PROCEDURE",! F LINE=1:1:132 W "=" 57 I SRNM W !,SRNAME_" * * Continued from previous page * *" 58 S PAGE=PAGE+1,SRHDR=1 I '$D(^TMP("SR",$J)) 59 Q 60 HDR2 ; more heading 61 ;I $Y+6<IOSL F I=$Y:1:IOSL-5 W ! 62 FOOT ; print footer 63 ;W ! F LINE=1:1:IOM W "-" 64 ;W !,"Occurrences(s): '*' Denotes Postop Occurrence",! F LINE=1:1:IOM W "-" 65 S SRHDR=0 I $E(IOST)'="P" W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S SRSOUT=1 66 Q 1 SROACMP1 ;BIR/ADM-M&M Verification Report (cont'd) ; [ 09/22/98 11:22 AM ] 2 ;;3.0; Surgery ;**47,68,77,50**;24 Jun 93 3 EN ; entry point 4 S (SRSOUT,SRSP)=0,SRINST=$P($$SITE^SROVAR,"^",2) W @IOF,!,?28,"M&M Verification Report",!!,"The M&M Verification Report is a tool to assist in the review of occurrences" 5 W !,"and their assignments to operations and in the review of death unrelated or",!,"related assignments to operations. Two varieties of this report are available." 6 W !,"The first variety provides a report of all patients who had operations within",!,"the selected date range who experienced introperative occurrences,",!,"postoperative occurrences, or death within 90 days of surgery. The second" 7 W !,"variety provides a similar report for all risk assessed operations that are in",!,"a completed state but have not yet transmitted to the national database.",! 8 D SEL G:SRSOUT END I SRFORM=2 G SPEC 9 D DATE^SROUTL(.SRSD,.SRED,.SRSOUT) G:SRSOUT END 10 SPEC I $D(^XUSEC("SROCHIEF",+DUZ)) N SRINSTP S SRINST=$$INST^SROUTL0() G:SRINST="^" END S SRINSTP=$P(SRINST,U),SRINST=$S(SRINST["ALL DIVISIONS":SRINST,1:$P(SRINST,U,2)) 11 W !! K DIR S DIR("A")="Do you want to print this report for all Surgical Specialties ",DIR("B")="YES",DIR(0)="Y" 12 S DIR("?",1)="Enter RETURN to print this report for all surgical specialties, or 'NO' to",DIR("?")="select a specific specialty." 13 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 G END 14 I 'Y D SP I SRSOUT G END 15 DEV K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Print the Report on which Device: ",%ZIS="QM" W !!,"This report is designed to use a 132 column format.",! D ^%ZIS I POP S SRSOUT=1 G END 16 I $D(IO("Q")) K IO("Q") S ZTDESC="M&M Verification Report",ZTRTN="BEG^SROACMP1",(ZTSAVE("SRFORM"),ZTSAVE("SRINST"),ZTSAVE("SRSP*"),ZTSAVE("SRINSTP"))="" S:SRFORM=1 (ZTSAVE("SRED"),ZTSAVE("SRSD"))="" D ^%ZTLOAD G END 17 BEG U IO S (SRHDR,SRNM,SRSOUT,SRSS)=0,PAGE=1,Y=DT X ^DD("DD") S SRPRINT="Report Generated: "_Y K ^TMP("SR",$J),^TMP("SRPAT",$J) 18 N SRFRTO I SRFORM=1 D 19 .S Y=SRSD X ^DD("DD") S SRFRTO="From: "_Y S Y=SRED X ^DD("DD") S SRFRTO=SRFRTO_" To: "_Y 20 .S SRSDT=SRSD-.0001,SREDT=SRED+.9999 F S SRSDT=$O(^SRF("AC",SRSDT)) Q:SRSDT>SREDT!'SRSDT!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDT,SRTN)) Q:'SRTN!SRSOUT D CASE 21 I SRFORM=2 F SRASS="C","N" S DFN=0 F S DFN=$O(^SRF("ARS",SRASS,"C",DFN)) Q:'DFN!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("ARS",SRASS,"C",DFN,SRTN)) Q:'SRTN!SRSOUT D CASE 22 G:SRSOUT END G ^SROACMP 23 CASE ; examine case 24 Q:'$D(^SRF(SRTN,0)) 25 I $D(^XUSEC("SROCHIEF",+DUZ)) Q:'$$MANDIV^SROUTL0(SRINSTP,SRTN) 26 I '$D(^XUSEC("SROCHIEF",+DUZ)) Q:'$$DIV^SROUTL0(SRTN) 27 I SRFORM=2,SRSP S Y=$P(^SRF(SRTN,0),"^",4) S:'Y Y="ZZ" I '$D(SRSP(Y)) Q 28 I '$P($G(^SRF(SRTN,.2)),"^",12)!$P($G(^SRF(SRTN,30)),"^")!($P($G(^SRF(SRTN,"NON")),"^")="Y") Q 29 S DFN=$P(^SRF(SRTN,0),"^") I $O(^SRF(SRTN,10,0))!$O(^SRF(SRTN,16,0)) S ^TMP("SR",$J,DFN,SRTN)=$P(^SRF(SRTN,0),"^",4) Q 30 S SRDEATH=$P($G(^DPT(DFN,.35)),"^") I SRDEATH S X1=$P(^SRF(SRTN,0),"^",9),X2=90 D C^%DTC S SRDAY=X I SRDEATH'>SRDAY S ^TMP("SR",$J,DFN,SRTN)=$P(^SRF(SRTN,0),"^",4) 31 Q 32 END Q:'$D(SRSOUT) W @IOF K ^TMP("SRPAT",$J),^TMP("SRSP",$J) I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP) S ZTREQ="@" Q 33 D ^%ZISC,^SRSKILL K SRTN W @IOF 34 Q 35 SEL ; select report version 36 K DIR S DIR("A",1)="Print which variety of the report ?",DIR("A",2)=" ",DIR("A",3)="1. Print full report for selected date range.",DIR("A",4)="2. Print pre-transmission report for completed risk assessments." 37 S DIR("A",5)=" ",DIR("A")="Enter selection (1 or 2): ",DIR("B")=1,DIR("?")="Please enter the number (1 or 2) matching your choice of report",DIR(0)="NA^1:2" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q 38 S SRFORM=Y 39 Q 40 SP W !! S SRSP=1 K DIC S DIC("S")="I '$P(^(0),""^"",3)",DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Print the report for which Specialty ? " D ^DIC I Y<0 S SRSOUT=1 Q 41 S SRCT=+Y,SRSP(SRCT)=+Y 42 MORE ; ask for more surgical specialties 43 K DIC S DIC("S")="I '$P(^(0),""^"",3)",DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Select an Additional Specialty: " D ^DIC I Y>0 S SRCT=+Y,SRSP(SRCT)=+Y G MORE 44 Q 45 HDR ; print heading 46 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q 47 I SRHDR D HDR2 Q:SRSOUT S SRHDR=0 48 W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,?124,"Page ",PAGE,!,?54,"M&M Verification Report" 49 W:SRFORM=1 !,?(132-$L(SRFRTO)\2),SRFRTO 50 W:SRFORM=2 !,?41,"Pre-Transmission Report for Completed Assessments" 51 W ?100,"Reviewed By:",!,?(132-$L(SRPRINT)\2),SRPRINT,?100,"Date Reviewed:",! 52 W !,?68,"Death",?120,"Assessment",!,"Op Date",?11,"Specialty",?25,"Procedure(s)",?67,"Related Occurrence(s) - (Date)",?120,"Type/Status",! F LINE=1:1:132 W "=" 53 I SRNM W !,SRNAME_" * * Continued from previous page * *" 54 S PAGE=PAGE+1,SRHDR=1 I '$D(^TMP("SR",$J)) 55 Q 56 HDR2 ; more heading 57 I $Y+5<IOSL F I=$Y:1:IOSL-5 W ! 58 FOOT ; print footer 59 W ! F LINE=1:1:IOM W "-" 60 W !,"Occurrences(s): '*' Denotes Postop Occurrence",?69,"Assessment Status - I:Incomplete, C:Complete, T:Transmitted",! F LINE=1:1:IOM W "-" 61 S SRHDR=0 I $E(IOST)'="P" W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S SRSOUT=1 62 Q
Note:
See TracChangeset
for help on using the changeset viewer.