Changeset 623 for WorldVistAEHR/trunk/r/SURGERY-SR/SROACMP.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SURGERY-SR/SROACMP.m
r613 r623 1 SROACMP ;BIR/ADM - M&M VERIFICATION REPORT ;12/19/07 2 ;;3.0; Surgery ;**47,50,127,143,166**;24 Jun 93;Build 7 3 S DFN=0 F S DFN=$O(^TMP("SR",$J,DFN)) Q:'DFN S SRTN=0 F S SRTN=$O(^TMP("SR",$J,DFN,SRTN)) Q:'SRTN D UTIL 4 I SRFORM=1,SRSP D SS 5 D HDR^SROACMP1 I $D(^TMP("SR",$J)) S SRPAT="" F S SRPAT=$O(^TMP("SRPAT",$J,SRPAT)) Q:SRPAT="" D Q:SRSOUT S SRNM=0 I $Y+7<IOSL W !! F LINE=1:1:132 W "-" 6 .S SRX=^(SRPAT),SRNAME=">>> "_SRPAT_" ("_$P(SRX,"^",2)_")",SRDEATH=$P(SRX,"^",3) 7 .I SRDEATH S SRNAME=SRNAME_" - DIED "_$E(SRDEATH,4,5)_"/"_$E(SRDEATH,6,7)_"/"_$E(SRDEATH,2,3) S X=$E(SRDEATH,9,12) I X S X=X_"000",SRNAME=SRNAME_"@"_$E(X,1,2)_":"_$E(X,3,4) 8 .I $Y+9>IOSL D HDR^SROACMP1 I SRSOUT Q 9 .W !,SRNAME S SRNM=1,DFN=$P(SRX,"^"),SRTN=0 F S SRTN=$O(^TMP("SR",$J,DFN,SRTN)) Q:'SRTN!SRSOUT D SET 10 G:SRSOUT END^SROACMP1 I '$D(^TMP("SR",$J)) W !!,"There are no perioperative occurrences or deaths recorded for ",$S(SRFORM=1:"surgeries performed in the selected date range.",1:"completed assessments not yet transmitted.") 11 D HDR2^SROACMP1,END^SROACMP1 12 Q 13 UTIL ; list all cases within 30 days prior to postop occurrence and/or 90 days prior to death 14 S SRPOST=0 F S SRPOST=$O(^SRF(SRTN,16,SRPOST)) Q:'SRPOST S SRDATE=$E($P(^SRF(SRTN,16,SRPOST,0),"^",7),1,7) I SRDATE S SRBACK=-30 D PRIOR 15 D DEM^VADPT S ^TMP("SRPAT",$J,VADM(1))=DFN_"^"_VA("PID")_"^"_$P(VADM(6),"^") 16 S SRDATE=$P(VADM(6),"^") I SRDATE S SRBACK=-90 D PRIOR 17 Q 18 PRIOR ; list cases in 30 days before this occurrence or 90 days before death 19 S X1=SRDATE,X2=SRBACK D C^%DTC S SDATE=X,SRCASE=0 F S SRCASE=$O(^SRF("B",DFN,SRCASE)) Q:'SRCASE I '$D(^TMP("SR",$J,DFN,SRCASE)) D 20 .I $D(^XUSEC("SROCHIEF",+DUZ)) Q:'$$MANDIV^SROUTL0(SRINSTP,SRTN) 21 .I '$D(^XUSEC("SROCHIEF",+DUZ)) Q:'$$DIV^SROUTL0(SRTN) 22 .I '$P($G(^SRF(SRCASE,.2)),"^",12)!$P($G(^SRF(SRCASE,30)),"^")!($P($G(^SRF(SRCASE,"NON")),"^")="Y") Q 23 .S SRX=$E($P(^SRF(SRCASE,0),"^",9),1,7) I SRX<SDATE!(SRX>SRDATE) Q 24 .S ^TMP("SR",$J,DFN,SRCASE)=$P(^SRF(SRCASE,0),"^",4) 25 Q 26 SET ; set variables to print 27 N SRSEP,SRICDN 28 S SR(0)=^SRF(SRTN,0),(SRD,Y)=$P(SR(0),"^",9),SRSDATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3),Y=$P(SR(0),"^",4) I Y S SRSS=$P(^SRO(137.45,Y,0),"^") 29 OPS S SROPER=$P(^SRF(SRTN,"OP"),"^") 30 K SRP,Z S:$L(SROPER)<121 SRP(1)=SROPER I $L(SROPER)>120 S SROPER=SROPER_" " F M=1:1 D OPER Q:Z="" 31 N SRL S SRL=109 D CPTS^SROAUTL0 I SRPROC(1)="" S SRPROC(1)="NOT ENTERED" 32 S SRCHK=0 I SRDEATH S X1=SRDEATH,X2=-90 D C^%DTC I SRD<X S SRCHK=1,SRREL="N/A" 33 I 'SRCHK S X=$P($G(^SRF(SRTN,.4)),"^",7),SRREL=$S(SRDEATH="":"N/A",X="U":"NO",X="R":"YES",1:"NOT ENTERED") 34 COMP ; perioperative occurrences 35 K SRC S (SRFG,SRIC)=0 F S SRIC=$O(^SRF(SRTN,10,SRIC)) Q:SRIC="" S SRFG=SRFG+1,SRO=^SRF(SRTN,10,SRIC,0),SRICD=$P(SRO,"^",3) D 36 .S Y=SRD D DATE S SRCAT=$P(SRO,"^",2) Q:'SRCAT S SRC(SRFG)=$P(^SRO(136.5,SRCAT,0),"^")_" "_SRY 37 .I SRICD S SRICDN=$$ICDDX^ICDCODE(SRICD,$P($G(^SRF(SRTN,0)),"^",9)),SRFG=SRFG+1,SRC(SRFG)=" ICD: "_$P(SRICDN,"^",2)_" "_$P(SRICDN,"^",4) 38 .S $P(SRC(SRFG),"^",2)="10;"_SRIC 39 S SRPC=0 F S SRPC=$O(^SRF(SRTN,16,SRPC)) Q:SRPC="" S SRFG=SRFG+1,SRO=^SRF(SRTN,16,SRPC,0),SRICD=$P(SRO,"^",3) D 40 .S Y=$E($P(SRO,"^",7),1,7) D DATE S SRCAT=$P(SRO,"^",2) Q:'SRCAT 41 .S SRSEP="" I SRCAT=3 S X=$P(SRO,"^",4) I X S SRSEP="/"_$S(X=2:"SEPSIS",X=3:"SEPTIC SHOCK",1:"SIRS")_" " 42 .S SRC(SRFG)=$P(^SRO(136.5,SRCAT,0),"^")_" ** POSTOP ** "_SRSEP_SRY 43 .I $P(SRO,"^",2)=3 S X=$P(SRO,"^",4) I X S SRSEP=$S(X=2:"SEPSIS",X=3:"SEPTIC SHOCK",1:"SIRS") 44 .I SRICD S SRICDN=$$ICDDX^ICDCODE(SRICD,$P($G(^SRF(SRTN,0)),"^",9)),SRFG=SRFG+1,SRC(SRFG)=" ICD: "_$P(SRICDN,"^",2)_" "_$P(SRICDN,"^",4) 45 .S $P(SRC(SRFG),"^",2)="16;"_SRPC 46 RA ; risk assessment type and status 47 S SRA=$G(^SRF(SRTN,"RA")),SRSTATUS=$P(SRA,"^"),SRTYPE=$P(SRA,"^",2),SRYN=$P(SRA,"^",6),SRE=$P(SRA,"^",7) D 48 .I SRTYPE="" S SRTYPE="NON-ASSESSED" Q 49 .S SRTYPE=$S(SRTYPE="C":"CARDIAC",SRYN="Y":"NON-CARDIAC",1:"EXCLUDED") 50 S SRSTATUS=$S(SRSTATUS="C":"COMPLETE",SRSTATUS="T":"TRANSMITTED",SRSTATUS="I":"INCOMPLETE",1:"N/A") 51 PRINT ; print case information 52 I $Y+8>IOSL D HDR^SROACMP1 I SRSOUT Q 53 W !!,SRSDATE,?11,SRTN,?25,SRSS,?80,SRTYPE,?98,SRSTATUS,?116,SRREL 54 W !,?11,SRP(1) W:$D(SRP(2)) !,?11,SRP(2) 55 W !,?11,"CPT Codes: ",SRPROC(1) W:$D(SRPROC(2)) !,?24,SRPROC(2) 56 W !,?11,"Occurrences: " I '$D(SRC(1)) S SRC(1)="NONE ENTERED" 57 S SRI=0 F S SRI=$O(SRC(SRI)) Q:'SRI D 58 .W:SRI>1 ! W ?24,$P(SRC(SRI),"^") 59 .I $Y+6>IOSL D HDR^SROACMP1 W ! I SRSOUT Q 60 .D TEXT D:SRT WP 61 S SRNDTH=$P($G(^SRF(SRTN,205)),"^",3) 62 I SRDEATH!SRNDTH D K SRNDTH 63 .I SRNDTH W !,?11,"Date of Death: "_$E(SRNDTH,4,5)_"/"_$E(SRNDTH,6,7)_"/"_$E(SRNDTH,2,3) S X=$E(SRNDTH,9,12) I X S X=X_"000" W "@"_$E(X,1,2)_":"_$E(X,3,4) 64 .W !,?11,"Review of Death Comments: " D 65 ..I '$O(^SRF(SRTN,47,0)) W "NONE ENTERED" Q 66 ..D DWP 67 Q 68 OPER ; break procedure if greater than 48 characters 69 S SRP(M)="" F LOOP=1:1 S Z=$P(SROPER," ") Q:Z="" Q:$L(SRP(M))+$L(Z)'<49 S SRP(M)=SRP(M)_Z_" ",SROPER=$P(SROPER," ",2,200) 70 Q 71 DATE S SRY=$S(Y:" ("_$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_")",1:" (NO DATE)") 72 Q 73 SS ; set up ^TMP for selected specialties 74 K ^TMP("SRSP",$J) S SRQ=0,SRNAME="" F S SRNAME=$O(^TMP("SRPAT",$J,SRNAME)) Q:SRNAME="" S DFN=$P(^TMP("SRPAT",$J,SRNAME),"^"),(SRQ,SRTN)=0 D 75 .F S SRTN=$O(^TMP("SR",$J,DFN,SRTN)) Q:'SRTN D Q:SRQ 76 ..S Y=$P(^SRF(SRTN,0),"^",4) S:'Y Y="ZZ" I $D(SRSP(Y)) S ^TMP("SRSP",$J,DFN)="",SRQ=1 Q 77 S SRNAME="" F S SRNAME=$O(^TMP("SRPAT",$J,SRNAME)) Q:SRNAME="" S DFN=$P(^TMP("SRPAT",$J,SRNAME),"^") I '$D(^TMP("SRSP",$J,DFN)) K ^TMP("SR",$J,DFN),^TMP("SRPAT",$J,SRNAME) 78 Q 79 WP ; print occurrence comments 80 N CM K ^UTILITY($J,"W") S CM=0 F S CM=$O(^SRF(SRTN,SRY,SRZ,1,CM)) Q:'CM S X=^SRF(SRTN,SRY,SRZ,1,CM,0),DIWL=30,DIWR=132 D ^DIWP 81 I $D(^UTILITY($J,"W")) F J=1:1:^UTILITY($J,"W",30) D 82 .I $Y+7>IOSL D HDR^SROACMP1 W ! I SRSOUT Q 83 .W !,?30,^UTILITY($J,"W",30,J,0) 84 Q 85 TEXT ; check for occurrence comments 86 S SRT=0,SRX=$P(SRC(SRI),"^",2) I SRX'="" S SRY=$P(SRX,";"),SRZ=$P(SRX,";",2) I $O(^SRF(SRTN,SRY,SRZ,1,0)) S SRT=1 W !,?26,">>> Comments:" 87 Q 88 DWP ; print review of death comments 89 N CM K ^UTILITY($J,"W") S CM=0 F S CM=$O(^SRF(SRTN,47,CM)) Q:'CM S X=^SRF(SRTN,47,CM,0),DIWL=38,DIWR=132 D ^DIWP 90 I $D(^UTILITY($J,"W")) F J=1:1:^UTILITY($J,"W",38) D 91 .I $Y+7>IOSL D HDR^SROACMP1 W ! I SRSOUT Q 92 .W ?38,^UTILITY($J,"W",38,J,0),! 93 Q 1 SROACMP ;BIR/ADM-M&M Verification Report ;02/20/05 2 ;;3.0; Surgery ;**47,50,127,143**;24 Jun 93 3 S DFN=0 F S DFN=$O(^TMP("SR",$J,DFN)) Q:'DFN S SRTN=0 F S SRTN=$O(^TMP("SR",$J,DFN,SRTN)) Q:'SRTN D UTIL 4 I SRFORM=1,SRSP D SS 5 D HDR^SROACMP1 I $D(^TMP("SR",$J)) S SRPAT="" F S SRPAT=$O(^TMP("SRPAT",$J,SRPAT)) Q:SRPAT="" D Q:SRSOUT S SRNM=0 I $Y+7<IOSL W !! F LINE=1:1:132 W "-" 6 .S SRX=^(SRPAT),SRNAME=">>> "_SRPAT_" ("_$P(SRX,"^",2)_")",SRDEATH=$P(SRX,"^",3) 7 .I SRDEATH S SRNAME=SRNAME_" - DIED "_$E(SRDEATH,4,5)_"/"_$E(SRDEATH,6,7)_"/"_$E(SRDEATH,2,3) S X=$E(SRDEATH,9,12) I X S X=X_"000",SRNAME=SRNAME_"@"_$E(X,1,2)_":"_$E(X,3,4) 8 .I $Y+9>IOSL D HDR^SROACMP1 I SRSOUT Q 9 .W !,SRNAME S SRNM=1,DFN=$P(SRX,"^"),SRTN=0 F S SRTN=$O(^TMP("SR",$J,DFN,SRTN)) Q:'SRTN!SRSOUT D SET 10 G:SRSOUT END^SROACMP1 I '$D(^TMP("SR",$J)) W !!,"There are no perioperative occurrences or deaths recorded for ",$S(SRFORM=1:"surgeries performed in the selected date range.",1:"completed assessments not yet transmitted.") 11 D HDR2^SROACMP1,END^SROACMP1 12 Q 13 UTIL ; list all cases within 90 days prior to postop occurrence and/or death 14 S SRPOST=0 F S SRPOST=$O(^SRF(SRTN,16,SRPOST)) Q:'SRPOST S SRDATE=$E($P(^SRF(SRTN,16,SRPOST,0),"^",7),1,7) I SRDATE S SRBACK=-30 D PRIOR 15 D DEM^VADPT S ^TMP("SRPAT",$J,VADM(1))=DFN_"^"_VA("PID")_"^"_$P(VADM(6),"^") 16 S SRDATE=$P(VADM(6),"^") I SRDATE S SRBACK=-90 D PRIOR 17 Q 18 PRIOR ; list cases in 30 days before this occurrence or 90 days before death 19 S X1=SRDATE,X2=SRBACK D C^%DTC S SDATE=X,SRCASE=0 F S SRCASE=$O(^SRF("B",DFN,SRCASE)) Q:'SRCASE I '$D(^TMP("SR",$J,DFN,SRCASE)) D 20 .I $D(^XUSEC("SROCHIEF",+DUZ)) Q:'$$MANDIV^SROUTL0(SRINSTP,SRTN) 21 .I '$D(^XUSEC("SROCHIEF",+DUZ)) Q:'$$DIV^SROUTL0(SRTN) 22 .I '$P($G(^SRF(SRCASE,.2)),"^",12)!$P($G(^SRF(SRCASE,30)),"^")!($P($G(^SRF(SRCASE,"NON")),"^")="Y") Q 23 .S SRX=$E($P(^SRF(SRCASE,0),"^",9),1,7) I SRX<SDATE!(SRX>SRDATE) Q 24 .S ^TMP("SR",$J,DFN,SRCASE)=$P(^SRF(SRCASE,0),"^",4) 25 Q 26 SET ; set variables to print 27 N SRSEP 28 S SR(0)=^SRF(SRTN,0),(SRD,Y)=$P(SR(0),"^",9),SRSDATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3),Y=$P(SR(0),"^",4) I Y S SRSS=$E($P($P(^SRO(137.45,Y,0),"^")," "),1,13),SRSS=$P(SRSS," "),SRSS=$P(SRSS,"(") 29 OPS S SROPER=$P(^SRF(SRTN,"OP"),"^"),OPER=0 F S OPER=$O(^SRF(SRTN,13,OPER)) Q:OPER="" D OTHER 30 K SRP,Z S:$L(SROPER)<40 SRP(1)=SROPER I $L(SROPER)>39 S SROPER=SROPER_" " F M=1:1 D OPER Q:Z="" 31 S SRCHK=0 I SRDEATH S X1=SRDEATH,X2=-90 D C^%DTC I SRD<X S SRCHK=1,SRREL="N/A" 32 I 'SRCHK S X=$P($G(^SRF(SRTN,.4)),"^",7),SRREL=$S(SRDEATH="":"N/A",X="U":"NO",X="R":"YES",1:" ?") 33 COMP ; perioperative occurrences 34 K SRC S (SRFG,SRIC)=0 F S SRIC=$O(^SRF(SRTN,10,SRIC)) Q:SRIC="" S SRFG=SRFG+1,SRO=^SRF(SRTN,10,SRIC,0),SRICD=$P(SRO,"^",3) D 35 .S Y=SRD D DATE S SRCAT=$P(SRO,"^",2) Q:'SRCAT S SRC(SRFG)=$P(^SRO(136.5,SRCAT,0),"^")_" "_SRY 36 .I SRICD S SRICDN=$$ICDDX^ICDCODE(SRICD,$P($G(^SRF(SRTN,0)),"^",9)),SRFG=SRFG+1,SRC(SRFG)=" ICD: "_$P(SRICDN,"^",2)_" "_$P(SRICDN,"^",4) 37 S SRPC=0 F S SRPC=$O(^SRF(SRTN,16,SRPC)) Q:SRPC="" S SRFG=SRFG+1,SRO=^SRF(SRTN,16,SRPC,0),SRICD=$P(SRO,"^",3) D 38 .S Y=$E($P(SRO,"^",7),1,7) D DATE S SRCAT=$P(SRO,"^",2) Q:'SRCAT 39 .S SRSEP="" I SRCAT=3 S X=$P(SRO,"^",4) I X S SRSEP="/"_$S(X=2:"SEPSIS",X=3:"SEPTIC SHOCK",1:"SIRS")_" " 40 .S SRC(SRFG)=$P(^SRO(136.5,SRCAT,0),"^")_" * "_SRSEP_SRY 41 .I $P(SRO,"^",2)=3 S X=$P(SRO,"^",4) I X S SRSEP=$S(X=2:"SEPSIS",X=3:"SEPTIC SHOCK",1:"SIRS") 42 .I SRICD S SRICDN=$$ICDDX^ICDCODE(SRICD,$P($G(^SRF(SRTN,0)),"^",9)),SRFG=SRFG+1,SRC(SRFG)=" ICD: "_$P(SRICDN,"^",2)_" "_$P(SRICDN,"^",4) 43 RA ; risk assessment type and status 44 S SRA=$G(^SRF(SRTN,"RA")),SRSTATUS=$P(SRA,"^"),SRTYPE=$P(SRA,"^",2),SRYN=$P(SRA,"^",6),SRE=$P(SRA,"^",7) D 45 .I SRTYPE="" S SRA="NON-ASSESSED" Q 46 .S SRA=$S(SRTYPE="C":"CARDIAC",SRYN="Y":"NON-CARD",1:"EXCLUDED")_"/"_SRSTATUS 47 PRINT ; print case information 48 I $Y+8>IOSL D HDR^SROACMP1 I SRSOUT Q 49 W !!,SRSDATE,?11,SRSS,?25,SRP(1),?69,SRREL W:$D(SRC(1)) ?75,SRC(1) W ?120,SRA 50 F SRC=2:1 Q:'$D(SRP(SRC))&'$D(SRC(SRC)) D Q:SRSOUT 51 .I $Y+6>IOSL D HDR^SROACMP1 I SRSOUT Q 52 .W ! W:$D(SRP(SRC)) ?25,SRP(SRC) W:$D(SRC(SRC)) ?75,SRC(SRC) 53 Q 54 OTHER ; other operations 55 S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,OPER,0),"^"))>250 S SRLONG=0,OPER=999,SROPERS=" ..." 56 I SRLONG S SROPERS=$P(^SRF(SRTN,13,OPER,0),"^") 57 S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS) 58 Q 59 OPER ; break procedure if greater than 40 characters 60 S SRP(M)="" F LOOP=1:1 S Z=$P(SROPER," ") Q:Z="" Q:$L(SRP(M))+$L(Z)'<40 S SRP(M)=SRP(M)_Z_" ",SROPER=$P(SROPER," ",2,200) 61 Q 62 DATE S SRY=$S(Y:" ("_$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_")",1:" (NO DATE)") 63 Q 64 SS ; set up ^TMP for selected specialties 65 K ^TMP("SRSP",$J) S SRQ=0,SRNAME="" F S SRNAME=$O(^TMP("SRPAT",$J,SRNAME)) Q:SRNAME="" S DFN=$P(^TMP("SRPAT",$J,SRNAME),"^"),(SRQ,SRTN)=0 D 66 .F S SRTN=$O(^TMP("SR",$J,DFN,SRTN)) Q:'SRTN D Q:SRQ 67 ..S Y=$P(^SRF(SRTN,0),"^",4) S:'Y Y="ZZ" I $D(SRSP(Y)) S ^TMP("SRSP",$J,DFN)="",SRQ=1 Q 68 S SRNAME="" F S SRNAME=$O(^TMP("SRPAT",$J,SRNAME)) Q:SRNAME="" S DFN=$P(^TMP("SRPAT",$J,SRNAME),"^") I '$D(^TMP("SRSP",$J,DFN)) K ^TMP("SR",$J,DFN),^TMP("SRPAT",$J,SRNAME) 69 Q
Note:
See TracChangeset
for help on using the changeset viewer.