Changeset 636 for FOIAVistA/tag/r/SURGERY-SR
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (15 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 48 edited
- 1 copied
-
. (copied) (copied from FOIAVistA/trunk/r )
-
SURGERY-SR/SROABCH.m (modified) (1 diff)
-
SURGERY-SR/SROACAR.m (modified) (3 diffs)
-
SURGERY-SR/SROACMP.m (modified) (4 diffs)
-
SURGERY-SR/SROACMP1.m (modified) (3 diffs)
-
SURGERY-SR/SROACOM.m (modified) (3 diffs)
-
SURGERY-SR/SROACOP.m (modified) (4 diffs)
-
SURGERY-SR/SROACPM.m (modified) (7 diffs)
-
SURGERY-SR/SROACPM1.m (modified) (3 diffs)
-
SURGERY-SR/SROACR2.m (modified) (2 diffs)
-
SURGERY-SR/SROALEC.m (modified) (4 diffs)
-
SURGERY-SR/SROALM.m (modified) (2 diffs)
-
SURGERY-SR/SROALOG.m (modified) (2 diffs)
-
SURGERY-SR/SROALT.m (modified) (2 diffs)
-
SURGERY-SR/SROALTP.m (modified) (3 diffs)
-
SURGERY-SR/SROALTS.m (modified) (2 diffs)
-
SURGERY-SR/SROALTSP.m (modified) (2 diffs)
-
SURGERY-SR/SROAMEAS.m (modified) (2 diffs)
-
SURGERY-SR/SROAMIS.m (modified) (2 diffs)
-
SURGERY-SR/SROAOP.m (modified) (2 diffs)
-
SURGERY-SR/SROAPAS.m (modified) (3 diffs)
-
SURGERY-SR/SROAPCA1.m (modified) (2 diffs)
-
SURGERY-SR/SROAPCA3.m (modified) (2 diffs)
-
SURGERY-SR/SROAPM.m (modified) (6 diffs)
-
SURGERY-SR/SROAPRE.m (modified) (2 diffs)
-
SURGERY-SR/SROAPRE1.m (modified) (3 diffs)
-
SURGERY-SR/SROAPRE2.m (modified) (2 diffs)
-
SURGERY-SR/SROAPRT1.m (modified) (4 diffs)
-
SURGERY-SR/SROAPRT2.m (modified) (3 diffs)
-
SURGERY-SR/SROAPRT4.m (modified) (2 diffs)
-
SURGERY-SR/SROAPRT5.m (modified) (2 diffs)
-
SURGERY-SR/SROAPS1.m (modified) (5 diffs)
-
SURGERY-SR/SROAPS2.m (modified) (3 diffs)
-
SURGERY-SR/SROASS.m (modified) (2 diffs)
-
SURGERY-SR/SROASSP.m (modified) (2 diffs)
-
SURGERY-SR/SROATCM3.m (modified) (2 diffs)
-
SURGERY-SR/SROATM1.m (modified) (2 diffs)
-
SURGERY-SR/SROATMNO.m (modified) (3 diffs)
-
SURGERY-SR/SROAUTL.m (modified) (3 diffs)
-
SURGERY-SR/SROAUTL1.m (modified) (3 diffs)
-
SURGERY-SR/SROAUTL3.m (modified) (2 diffs)
-
SURGERY-SR/SROAUTL4.m (modified) (2 diffs)
-
SURGERY-SR/SROAUTLC.m (modified) (2 diffs)
-
SURGERY-SR/SROCODE.m (modified) (1 diff)
-
SURGERY-SR/SROESPR1.m (modified) (2 diffs)
-
SURGERY-SR/SROGMTS.m (modified) (4 diffs)
-
SURGERY-SR/SROMED.m (modified) (3 diffs)
-
SURGERY-SR/SROWL.m (modified) (2 diffs)
-
SURGERY-SR/SROXR4.m (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/SURGERY-SR/SROABCH.m
r628 r636 1 SROABCH ;B IR/MAM - BATCH PRINT ASSESSMENTS ;11/28/072 ;;3.0; Surgery ;**77 ,166**;24 Jun 93;Build 61 SROABCH ;B'HAM ISC/MAM - BATCH PRINT ASSESSMENTS ; [ 01/08/98 9:54 AM ] 2 ;;3.0; Surgery ;**77**;24 Jun 93 3 3 DATE ; get dates 4 S (SRSOUT,SRSP)=0 W @IOF,!!,"This report will print all completed or transmitted assessments that have a",!,"date of operationwithin the date range selected.",!4 S SRSOUT=0 W @IOF,!!,"This report will print all completed or transmitted assessments that have a",!,"'date completed' within the date range selected.",! 5 5 D DATE^SROUTL(.SRASTDT,.SRAENDT,.SRSOUT) G:SRSOUT END 6 D SPEC7 6 W !!,"Depending on the date range entered, this report may be very long. You should",!,"QUEUE this report to the selected printer.",! 8 7 K %ZIS,IOP,POP,IO("Q") S %ZIS="Q",%ZIS("A")="Print on which Device: " D ^%ZIS S:POP SRSOUT=1 G:POP END 9 I $D(IO("Q")) K IO("Q") S ZTRTN="EN^SROABCH",(ZTSAVE("SRSITE*"),ZTSAVE("SRASTDT"),ZTSAVE("SRAENDT") ,ZTSAVE("SRSP"))="",ZTDESC="Batch Print Risk Assessments" D ^%ZTLOAD S SRSOUT=1 G END8 I $D(IO("Q")) K IO("Q") S ZTRTN="EN^SROABCH",(ZTSAVE("SRSITE*"),ZTSAVE("SRASTDT"),ZTSAVE("SRAENDT"))="",ZTDESC="Batch Print Risk Assessments" D ^%ZTLOAD S SRSOUT=1 G END 10 9 EN ; entry when queued 11 10 S SRSOUT=0,SRABATCH=1 12 11 U IO S SRAENDT=SRAENDT+.9999,SDATE=SRASTDT-.0001 F S SDATE=$O(^SRF("AC",SDATE)) Q:'SDATE!(SDATE>SRAENDT)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",SDATE,SRTN)) Q:'SRTN!SRSOUT D STUFF 13 12 END I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q 13 I $E(IOST)'="P",'SRSOUT W !!,"Press RETURN to continue " R X:DTIME 14 14 D ^%ZISC K SRTN W @IOF D ^SRSKILL 15 15 Q 16 STUFF ; 17 I SRSP,$P(^SRF(SRTN,0),"^",4)'=SRSP Q 18 S DATE=$P(^SRF(SRTN,0),"^",9) 16 STUFF S DATE=$P(^SRF(SRTN,0),"^",9) 19 17 S SR("RA")=$G(^SRF(SRTN,"RA")),X=$P(SR("RA"),"^") I X'="T",X'="C" Q 20 18 I $P(SR("RA"),"^",6)'="Y" Q 21 19 K SRA D ^SROAPAS 22 20 Q 23 SPEC ; select specialty24 W ! K DIR S DIR(0)="YA",DIR("A")="Print report for ALL surgical specialties ? ",DIR("B")="YES"25 S DIR("?",1)="Enter YES to print the report for all surgical specialties, or NO to",DIR("?")="print the report for a specific surgical specialty."26 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q27 I 'Y W ! K DIC S DIC("S")="I '$P(^(0),""^"",3)",DIC("A")="Print the Report for which Surgical Specialty: ",DIC=137.45,DIC(0)="QEAMZ" D ^DIC K DIC S:Y<0 SRSOUT=1 Q:Y<0 S SRSP=+Y28 Q -
FOIAVistA/tag/r/SURGERY-SR/SROACAR.m
r628 r636 1 SROACAR ;BIR/MAM - OPEATIVE DATA ; 12/03/072 ;;3.0; Surgery ;**38,71,93,95,100,125,142,153 ,166**;24 Jun 93;Build 61 SROACAR ;BIR/MAM - OPEATIVE DATA ;03/29/06 2 ;;3.0; Surgery ;**38,71,93,95,100,125,142,153**;24 Jun 93;Build 11 3 3 I '$D(SRTN) W !!,"A Surgery Risk Assessment must be selected prior to using this option.",!!,"Press <RET> to continue " R X:DTIME G END 4 4 S SRACLR=0,SRSOUT=0,SRSUPCPT=1 D ^SROAUTL 5 5 START D:SRACLR RET G:SRSOUT END S SRACLR=0 K SRA,SRAO D ^SROACR1 6 ASK W !,"Select Cardiac ProceduresOperative Information to Edit: " R X:DTIME I '$T!("^"[X) G END7 S X=$S(X="a":"A",X="n":"N",1:X) I '$D(SRAO(X)),(X'?.N1":".N),(X'="A"),(X'="N") D HELP G:SRSOUT END G START6 ASK W !,"Select Operative Information to Edit: " R X:DTIME I '$T!("^"[X) G END 7 S:X="a" X="A" I '$D(SRAO(X)),(X'?.N1":".N),(X'="A") D HELP G:SRSOUT END G START 8 8 I X="A" S X="1:22" 9 9 I X?.N1":".N S Y=$E(X),Z=$P(X,":",2) I Y<1!(Z>22)!(Y>Z) D HELP G:SRSOUT END G START 10 I X="N" D G:SRSOUT END G START11 .W ! K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to set all fields on this page to NO"12 .D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q13 .I Y D NO2ALL14 10 D HDR^SROAUTL 15 11 I X?.N1":".N D RANGE G START … … 22 18 Q 23 19 HELP W @IOF,!!!!,"Enter the number or range of numbers you want to edit. Examples of proper",!,"responses are listed below." 24 W !!,"1. Enter 'A' to update all information.",!!,"2. Enter 'N' to set all fields on this page to NO." 25 W !!,"3. Enter a number (1-22) to update the information in that field. (For",!," example, enter '9' to update Valve Repair.)" 26 W !!,"4. Enter a range of numbers (1-22) separated by a ':' to enter a range of",!," information. (For example, enter '6:8' to enter Aortic Valve",!," Replacement, Mitral Valve Replacement, and Tricuspid Valve Replacement.)" 20 W !!,"1. Enter 'A' to update all information.",!!,"2. Enter a number (1-22) to update the information in that field. (For",!," example, enter '9' to update Valve Repair.)" 21 W !!,"3. Enter a range of numbers (1-22) separated by a ':' to enter a range of",!," information. (For example, enter '6:8' to enter Aortic Valve",!," Replacement, Mitral Valve Replacement, and Tricuspid Valve Replacement.)" 27 22 D RET 28 23 Q … … 37 32 I 'SRSOUT,EMILY=12!(EMILY=13) D OK 38 33 Q 39 NO2ALL ; set all fields to NO40 N II K DR,DIE S DA=SRTN,DIE=13041 F II=367,368,369,371,481,483,376,380,378,377,379,373,372,505,502 S DR=$S($D(DR):DR_";",1:"")_II_"////N"42 F II=365,366,464,465,416 S DR=DR_";"_II_"////0"43 S DR=DR_";"_370_"////5"_";"_512_"////N"44 D ^DIE K DR45 Q46 34 OK N SRISCH,SRCPB S X=$G(^SRF(SRTN,206)),SRISCH=$P(X,"^",36),SRCPB=$P(X,"^",37) 47 35 I SRISCH,SRCPB,SRISCH>SRCPB W !!," *** NOTE: Ischemic Time is greater than CPB Time!! Please check. ***",! D RET W ! -
FOIAVistA/tag/r/SURGERY-SR/SROACMP.m
r628 r636 1 SROACMP ;BIR/ADM - M&M VERIFICATION REPORT ;12/19/072 ;;3.0; Surgery ;**47,50,127,143 ,166**;24 Jun 93;Build 61 SROACMP ;BIR/ADM-M&M Verification Report ;02/20/05 2 ;;3.0; Surgery ;**47,50,127,143**;24 Jun 93 3 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 4 I SRFORM=1,SRSP D SS … … 11 11 D HDR2^SROACMP1,END^SROACMP1 12 12 Q 13 UTIL ; list all cases within 30 days prior to postop occurrence and/or 90 days prior todeath13 UTIL ; list all cases within 90 days prior to postop occurrence and/or death 14 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 15 D DEM^VADPT S ^TMP("SRPAT",$J,VADM(1))=DFN_"^"_VA("PID")_"^"_$P(VADM(6),"^") … … 25 25 Q 26 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" 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="" 32 31 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")32 I 'SRCHK S X=$P($G(^SRF(SRTN,.4)),"^",7),SRREL=$S(SRDEATH="":"N/A",X="U":"NO",X="R":"YES",1:" ?") 34 33 COMP ; perioperative occurrences 35 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 36 35 .S Y=SRD D DATE S SRCAT=$P(SRO,"^",2) Q:'SRCAT S SRC(SRFG)=$P(^SRO(136.5,SRCAT,0),"^")_" "_SRY 37 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) 38 .S $P(SRC(SRFG),"^",2)="10;"_SRIC39 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 40 38 .S Y=$E($P(SRO,"^",7),1,7) D DATE S SRCAT=$P(SRO,"^",2) Q:'SRCAT 41 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")_" " 42 .S SRC(SRFG)=$P(^SRO(136.5,SRCAT,0),"^")_" ** POSTOP ** "_SRSEP_SRY40 .S SRC(SRFG)=$P(^SRO(136.5,SRCAT,0),"^")_" * "_SRSEP_SRY 43 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") 44 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) 45 .S $P(SRC(SRFG),"^",2)="16;"_SRPC46 43 RA ; risk assessment type and status 47 44 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") 45 .I SRTYPE="" S SRA="NON-ASSESSED" Q 46 .S SRA=$S(SRTYPE="C":"CARDIAC",SRYN="Y":"NON-CARD",1:"EXCLUDED")_"/"_SRSTATUS 51 47 PRINT ; print case information 52 48 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 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) 67 53 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) 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) 70 61 Q 71 62 DATE S SRY=$S(Y:" ("_$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_")",1:" (NO DATE)") … … 77 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) 78 69 Q 79 WP ; print occurrence comments80 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 ^DIWP81 I $D(^UTILITY($J,"W")) F J=1:1:^UTILITY($J,"W",30) D82 .I $Y+7>IOSL D HDR^SROACMP1 W ! I SRSOUT Q83 .W !,?30,^UTILITY($J,"W",30,J,0)84 Q85 TEXT ; check for occurrence comments86 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 Q88 DWP ; print review of death comments89 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 ^DIWP90 I $D(^UTILITY($J,"W")) F J=1:1:^UTILITY($J,"W",38) D91 .I $Y+7>IOSL D HDR^SROACMP1 W ! I SRSOUT Q92 .W ?38,^UTILITY($J,"W",38,J,0),!93 Q -
FOIAVistA/tag/r/SURGERY-SR/SROACMP1.m
r628 r636 1 SROACMP1 ;BIR/ADM - M&M VERIFICATION REPORT (CONT'D) ;11/26/072 ;;3.0; Surgery ;**47,68,77,50 ,166**;24 Jun 93;Build 61 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 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.",! 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.",! 12 8 D SEL G:SRSOUT END I SRFORM=2 G SPEC 13 9 D DATE^SROUTL(.SRSD,.SRED,.SRSOUT) G:SRSOUT END … … 38 34 Q 39 35 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."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." 41 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 42 38 S SRFORM=Y … … 52 48 W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,?124,"Page ",PAGE,!,?54,"M&M Verification Report" 53 49 W:SRFORM=1 !,?(132-$L(SRFRTO)\2),SRFRTO 54 W:SRFORM=2 !,?41,"P RE-TRANSMISSION REPORT FOR COMPLETED ASSESSMENTS"55 W ?100,"R EVIEWED 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 "="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 "=" 57 53 I SRNM W !,SRNAME_" * * Continued from previous page * *" 58 54 S PAGE=PAGE+1,SRHDR=1 I '$D(^TMP("SR",$J)) 59 55 Q 60 56 HDR2 ; more heading 61 ;I $Y+6<IOSL F I=$Y:1:IOSL-5 W !57 I $Y+5<IOSL F I=$Y:1:IOSL-5 W ! 62 58 FOOT ; print footer 63 ;W ! F LINE=1:1:IOM W "-"64 ;W !,"Occurrences(s): '*' Denotes Postop Occurrence",! F LINE=1:1:IOM W "-"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 "-" 65 61 S SRHDR=0 I $E(IOST)'="P" W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S SRSOUT=1 66 62 Q -
FOIAVistA/tag/r/SURGERY-SR/SROACOM.m
r628 r636 1 SROACOM ;BIR/MAM - COMPLETE ASSESSMENT ; 12/19/072 ;;3.0; Surgery ;**38,55,63,65,88,93,95,102,100,125,134,142,160 ,166**;24 Jun 93;Build 61 SROACOM ;BIR/MAM - COMPLETE ASSESSMENT ;02/08/07 2 ;;3.0; Surgery ;**38,55,63,65,88,93,95,102,100,125,134,142,160**;24 Jun 93;Build 7 3 3 I '$D(SRTN) Q 4 I $P($G(^SRF(SRTN,"RA")),"^",2)="C" G ^SROACOM15 4 S (SRSFLG,SRSOUT,SROVER)=0,SRA=$G(^SRF(SRTN,"RA")),Y=$P(SRA,"^") I Y'="I" W !!,"This assessment has a "_$S(Y="C":"'COMPLETE'",1:"'TRANSMITTED'")_" status.",!!,"No action taken." G END 6 5 I $P(SRA,"^",2)="N",$P(SRA,"^",6)="Y" D CHK^SROAUTL 7 6 I $P(SRA,"^",2)="N",$P(SRA,"^",6)="N" D CHK^SROAUTL3 7 I $P(SRA,"^",2)="C" D CHK^SROAUTLC 8 8 S SRFLD="" I $O(SRX(SRFLD))'="" D LIST 9 I $P(SRA,"^",2)="C" D CHCK G:SRSOUT END 9 10 YEP I '$P($G(^SRO(136,SRTN,10)),"^")!('$P($G(^SRO(136,SRTN,0)),"^",2))!('$P($G(^SRO(136,SRTN,0)),"^",3)) W !!,?6,"The coding for Procedure and Diagnosis is not complete." 10 11 W ! S SRFLD="" K DIR S DIR("A")="Are you sure you want to complete this assessment ? ",DIR("B")=$S($O(SRX(SRFLD)):"NO",1:"YES"),DIR(0)="YA" … … 28 29 END I 'SRSOUT,$E(IOST)'="P" D RET 29 30 W @IOF I $E(IOST)="P" D ^%ZISC W @IOF 30 D ^SRSKILL K SR MD,SRMD1,SRSFLG31 D ^SRSKILL K SRSFLG 31 32 Q 32 33 LIST W @IOF,!,"This assessment is missing the following items:",! S SRZ="",SRCNT=1 34 ;I '$P($G(^SRO(136,SRTN,10)),"^")!('$P($G(^SRO(136,SRTN,0)),"^",2))!('$P($G(^SRO(136,SRTN,0)),"^",3)) W !,?6,"The coding for Procedure and Diagnosis is",!,?6,"not complete.",! 33 35 F S SRZ=$O(SRX(SRZ)) Q:SRZ="" D:$Y+5>IOSL RET Q:SRSOUT W !,?5,$J(SRCNT,2)_". "_$P(SRX(SRZ),"^") S SRCNT=SRCNT+1 34 36 S SRSOUT=0 W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to enter the missing items at this time",DIR("B")="NO" D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q … … 38 40 .I $E(SRMD,1,10)="ANESTHESIA" D ANES Q 39 41 .I $E(SRMD,1,6)="POSTOP"!($E(SRMD,1,6)="SEPSIS") D POST^SROCMPS Q 42 .I SRMD=240 D FUNCT Q 43 .I SRMD=492 D FUNCTI^SROAPRE Q 44 .I SRMD=485 W @IOF,! D PRIOR^SROACL2 K DR,DIE S DA=SRTN,DR="485///"_$S(X="@":"@",1:$P(Y,"^")),DIE=130 D ^DIE K DR S:$D(Y) SRSFLG=1 Q 40 45 .K DR,DIE S DA=SRTN,DIE=130,DR=$S($G(SRMD1):SRMD1,1:SRMD)_"T" D ^DIE K DR I $D(Y) S SRSFLG=1 41 46 S:'$G(SRSOUT) SRSOUT=0 42 47 Q 48 FUNCT I $P($G(^SRF(SRTN,"RA")),"^",2)="C" D FUNCT^SROACLN Q 49 D FUNCTJ^SROAPRE 50 Q 43 51 ANES K DR,DIE,DA S DA=SRTN,DR=.37,DR(2,130.06)=".01T;.05T;42T",DIE=130 D ^DIE S:$D(Y) SRSFLG=1 K DR 52 Q 53 CHCK ; cardiac checks added by SR*3*93 54 N SRADM,SRDIS,SRISCH,SRCPB,SRRET S SRRET=0,X=$G(^SRF(SRTN,208)),SRADM=$P(X,"^",14),SRDIS=$P(X,"^",15),X=$G(^SRF(SRTN,206)),SRISCH=$P(X,"^",36),SRCPB=$P(X,"^",37) 55 I SRADM,SRDIS,SRADM'<SRDIS W !!," *** NOTE: Discharge Date precedes Admission Date!! Please check. ***" S SRRET=1,SRX(418)="" 56 I SRISCH,SRCPB,SRISCH>SRCPB W !!," *** NOTE: Ischemic Time is greater than CPB Time!! Please check. ***",! S SRRET=1,SRX(450)="" 57 I SRRET W ! K DIR S DIR(0)="E" D ^DIR K DIR S:$D(DTOUT)!$D(DUOUT) SRSOUT=1 W ! 44 58 Q 45 59 RET W !! K DIR S DIR(0)="E" D ^DIR K DIR W @IOF I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 -
FOIAVistA/tag/r/SURGERY-SR/SROACOP.m
r628 r636 1 SROACOP ;BIR/MAM - CARDIAC OPERATIVE RISK SUMMARY ; 12/20/072 ;;3.0; Surgery ;**38,47,71,88,95,107,100,125,142,153,160 ,166**;24 Jun 93;Build 61 SROACOP ;BIR/MAM - CARDIAC OPERATIVE RISK SUMMARY ;02/14/07 2 ;;3.0; Surgery ;**38,47,71,88,95,107,100,125,142,153,160**;24 Jun 93;Build 7 3 3 I '$D(SRTN) W !!,"A Surgery Risk Assessment must be selected prior to using this option.",!!,"Press <RET> to continue " R X:DTIME G END 4 4 N SRCSTAT S SRACLR=0,SRSOUT=0,SRSUPCPT=1 D ^SROAUTL … … 8 8 S Y=$P($G(^SRF(SRTN,1.1)),"^",3),C=$P(^DD(130,1.13,0),"^",2) D:Y'="" Y^DIQ S SRAO(2)=Y_"^1.13" 9 9 S SRAO(1)=$P(SRA(206),"^",31)_"^364",SRAO(3)=$P(SRA(208),"^",12)_"^414" 10 S (X,Y)=$P(SRA(206),"^",32) D:YDT S SRAO("1A")=X_"^364.1"10 S Y=$P(SRA(206),"^",32) D DT S SRAO("1A")=X_"^364.1" 11 11 S Y=$P(SRAO(3),"^") I Y'="" S C=$P(^DD(130,414,0),"^",2) D Y^DIQ S $P(SRAO(3),"^")=Y 12 12 S Y=$P(SRA(208),"^",13) D DT S SRAO("3A")=X_"^414.1" … … 16 16 S SRCSTAT=">> Coding "_$S($P($G(^SRO(136,SRTN,10)),"^"):"",1:"Not ")_"Complete <<" 17 17 S SRPAGE="PAGE: 1" D HDR^SROAUTL S SRAO(7)="" 18 S (X,X1)=$P(SRAO(1),"^"),X=$S(X?1.3N:X_"%",1:X) W !," 1. Physician's Preoperative Estimate of Operative Mortality: "_X19 S X=$P(SRAO("1A"),"^") I X 1'=""!(X'="")W !,?3," A. Date/Time Collected: "_X18 S X=$P(SRAO(1),"^"),X=$S(X?1.3N:X_"%",1:X) W !," 1. Physician's Preoperative Estimate of Operative Mortality: "_X 19 S X=$P(SRAO("1A"),"^") I X'="" W !,?3," A. Date/Time Collected: "_X 20 20 W !," 2. ASA Classification:",?31,$P(SRAO(2),"^"),!," 3. Surgical Priority:",?31,$P(SRAO(3),"^") 21 21 S X=$P(SRAO("3A"),"^") I X'="" W !,?3," A. Date/Time Collected: "_X … … 56 56 I EMILY=7 D DISP^SROAUTL0 Q 57 57 K DR,DIE S DA=SRTN,DIE=130,DR=$P(SRAO(EMILY),"^",2) 58 S DR=DR_"T",DIE=130 S DR=DR_$S(EMILY=3:";414.1T",1:"") D ^DIE K DR I $D(Y) S SRSOUT=1 59 I EMILY=1 D 60 .I $P(^SRF(SRTN,206),"^",31)="NS" S $P(^SRF(SRTN,206),"^",32)="NS" Q 61 .S DR="364.1T",DIE=130 D ^DIE K DR I $D(Y) S SRSOUT=1 58 S DR=DR_"T",DIE=130 S DR=DR_$S(EMILY=1:";364.1T",EMILY=3:";414.1T",1:"") D ^DIE K DR I $D(Y) S SRSOUT=1 62 59 Q 63 60 RET Q:SRSOUT W !!,"Press ENTER to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q -
FOIAVistA/tag/r/SURGERY-SR/SROACPM.m
r628 r636 1 SROACPM ;BIR/ADM - CARDIAC RESOURCE INFO ; 12/04/072 ;;3.0; Surgery ;**71,93,95,99,100,125,142,160,164 ,166**;24 Jun 93;Build 61 SROACPM ;BIR/ADM - CARDIAC RESOURCE INFO ;08/23/07 2 ;;3.0; Surgery ;**71,93,95,99,100,125,142,160,164**;24 Jun 93;Build 2 3 3 ; 4 4 ; Reference to ^DGPM("APTT1" supported by DBIA #565 … … 11 11 S DIR("A")="Select Number",DIR(0)="NO^1:2" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y S SRSOUT=1 G END 12 12 I Y=1 D PIMS G START 13 EDIT N DAYS,HOURS,MINS 14 S:$P(^SRF(SRTN,206),"^",41)="" $P(^SRF(SRTN,206),"^",41)="N" 15 S SRR=0 S SRPAGE="PAGE: 1" D HDR^SROAUTL K DR S SRQ=0,(DR,SRDR)="418;419;440;.205;.232;470;471;473;472;431;442;513;515" 13 EDIT S:$P(^SRF(SRTN,206),"^",41)="" $P(^SRF(SRTN,206),"^",41)="N" 14 S SRR=0 S SRPAGE="PAGE: 1" D HDR^SROAUTL K DR S SRQ=0,(DR,SRDR)="418;419;440;.205;.232;470;471;473;472;431;442;513" 16 15 K DA,DIC,DIQ,SRY S DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="IE",DR=SRDR D EN^DIQ1 K DA,DIC,DIQ,DR 17 16 K SRZ S SRZ=0 F M=1:1 S I=$P(SRDR,";",M) Q:'I D … … 35 34 EXT I SRFLD=440&(SREXT="NS") S SREXT=SREXT_"-"_$S(SREXT="NS":"No Study",1:SREXT) 36 35 I SRFLD=470,(SREXT="NS"!(SREXT="RI")) S SREXT=SREXT_"-"_$S(SREXT="NS":"Unable to determine",SREXT="RI":"Remains intubated at 30 days",1:SREXT) 37 I SRFLD=470,$G(SRY(130,SRTN,470,"I")) D Q38 .S X=$$FMDIFF^XLFDT(SRY(130,SRTN,470,"I"),SRY(130,SRTN,.232,"I"),2) W ?39,SREXT,!,?10,"Postop Intubation Hrs: "_$FN((X/3600),"+",1)39 36 I SRFLD=471,(SREXT="NS"!(SREXT="RI")) S SREXT=SREXT_"-"_$S(SREXT="NS":"Unable to determine",SREXT="RI":"Remains in ICU at 30 days",1:SREXT) 40 37 I $L(SREXT)<41 W ?39,SREXT W:SRFLD=247 $S(SREXT="":"",SREXT=1:" Day",SREXT=0:" Days",SREXT>1:" Days",1:"") Q … … 44 41 ..F I=0:1:50 S J=51-I,Y=$E(X,J) I Y=" " W ?28,$E(X,1,J-1) S X=$E(X,J+1,$L(X)) Q 45 42 Q 46 SEL S SRSOUT=0 W !!,"Select Resource Information to Edit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q43 SEL S SRSOUT=0 W !!,"Select number of item to edit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q 47 44 Q:X="" S:X="a" X="A" I '$D(SRFLG),'$D(SRZ(X)),(X'?1.2N1":"1.2N),X'="A" D HELP S SRR=1 Q 48 45 I X?1.2N1":"1.2N S Y=$P(X,":"),Z=$P(X,":",2) I Y<1!(Z>SRZ)!(Y>Z) D HELP S SRR=1 Q … … 68 65 ONE ; edit one item 69 66 I EMILY=7 D LIST 70 I EMILY'=7K DR,DA,DIE S DR=$P(SRZ(EMILY),"^",2)_"T",DA=SRTN,DIE=130,SRDT=$P(SRZ(EMILY),"^",3) S:SRDT DR=DR_";"_SRDT_"T" D ^DIE K DR,DA I $D(Y) S SRSOUT=167 K DR,DA,DIE S DR=$P(SRZ(EMILY),"^",2)_"T",DA=SRTN,DIE=130,SRDT=$P(SRZ(EMILY),"^",3) S:SRDT DR=DR_";"_SRDT_"T" D ^DIE K DR,DA I $D(Y) S SRSOUT=1 71 68 I 'SRSOUT,EMILY=1!(EMILY=2) D OK 72 I EMILY=12 D CHK73 69 Q 74 70 OK ; compare admission date to discharge date … … 76 72 I SRADM,SRDIS,SRADM'<SRDIS W !!," *** NOTE: Discharge Date precedes Admission Date!! Please check. ***",! D PRESS W ! 77 73 Q 78 CHK ; compare date OF OPERATION to CT Surgery Consult Date79 S X1=$P(^SRF(SRTN,0),"^",9),X2=$P($G(^SRF(SRTN,209)),"^",15) D ^%DTC I X'>30 S $P(^SRF(SRTN,209),"^",16)="N" Q80 S $P(^SRF(SRTN,209),"^",16)="" K DR,DA,DIE S DR=$P(SRZ(13),"^",2)_"T",DA=SRTN,DIE=130,SRDT=$P(SRZ(13),"^",3) S:SRDT DR=DR_";"_SRDT_"T" D ^DIE K DR,DA I $D(Y) S SRSOUT=181 Q82 74 LIST ; display list of patient movements 83 N CNT,SRADM,SRLOC,SRMOVE,SRMVMT,SR N,SRT,SRTYPE,SRZ,SRY75 N CNT,SRADM,SRLOC,SRMOVE,SRMVMT,SRT,SRTYPE,SRZ,SRY 84 76 S DFN=$P(^SRF(SRTN,0),"^"),SRZ=$P($G(^SRF(SRTN,.2)),"^",12) 85 S SRADM=0 D ADM 86 S CNT=0 F Q:'SRZ D :SRZMVMT87 ;Q:CNT=077 S SRADM=0 D ADM Q:'SRZ 78 S CNT=0 F Q:'SRZ D MVMT 79 Q:CNT=0 88 80 W !!,?5,"To identify the date and time the patient was discharged from intensive",!,?5,"care following surgery, see the following list of patient movements" 89 81 W !,?5,"that occurred during the inpatient stay associated with this surgery.",! 90 S (CNT,SRN)=0 F S CNT=$O(SRMVMT(CNT)) Q:'CNT S X=SRMVMT(CNT),SRT=$P(X,"^",2),SRN=SRN+1 W !,$J(SRN,3)_".",?5,$P($P(X,"^"),":",1,2),?25,$P(X,"^",3),?37,$S(SRT=3:"From",1:"To")_": "_$P(X,"^",4) 91 I '$O(SRMVMT(0)) W !,?5,">> No postoperative patient movements were found for this patient." 92 W ! E K DIR S DIR("A")="Select patient movement from list",DIR(0)="NO^1:"_SRN_":0" D ^DIR K DIR I Y D Q 93 .S SRT=$P($P(SRMVMT(Y),"^"),":",1,2) K DA,DIE,DR S DA=SRTN,DIE=130,DR="471///"_SRT D ^DIE K DA,DIE,DR 94 K DA,DIE,DR S DA=SRTN,DIE=130,DR="471T" D ^DIE K DA,DIE,DR 82 S CNT=0 F S CNT=$O(SRMVMT(CNT)) Q:'CNT S X=SRMVMT(CNT),SRT=$P(X,"^",2) W !,?5,$P($P(X,"^"),":",1,2),?25,$P(X,"^",3),?37,$S(SRT=3:"From",1:"To")_": "_$P(X,"^",4) 83 W ! 95 84 Q 96 85 MVMT S VAIP("D")=SRZ D IN5^VADPT S SRY=$P(VAIP(3),"^") … … 125 114 DGB ;;472^Surg Performed at Non-VA Facility 126 115 EAC ;;513^CT Surgery Consult Date 127 EAE ;;515^Cause for Delay for Surgery -
FOIAVistA/tag/r/SURGERY-SR/SROACPM1.m
r628 r636 1 SROACPM1 ;BIR/SJA - LAB INFO ;0 1/14/082 ;;3.0; Surgery ;**125,153 ,166**;24 Jun 93;Build 61 SROACPM1 ;BIR/SJA - LAB INFO ;05/04/06 2 ;;3.0; Surgery ;**125,153**;24 Jun 93;Build 11 3 3 I '$D(SRTN) W !!,"A Surgery Risk Assessment must be selected prior to using this option.",!!,"Press <RET> to continue " R X:DTIME G END 4 4 S SRSOUT=0 D ^SROAUTL … … 27 27 RET Q:SRSOUT W !!,"Press <RET> to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q 28 28 Q 29 DISP N SRXS SRPAGE="PAGE: 1",SRHDR(.5)="PREOPERATIVE LABORATORY RESULTS" D HDR^SROAUTL30 S SRX=$P(SRAO(1),"^") W !," 1. HDL:",?25,$J(SRX,6),?35,$$NORCHK(21,SRX),?38,$P(SRAO(1),"^",2)31 S SRX=$P(SRAO(2),"^") W !," 2. LDL:",?25,$J(SRX,6),?35,$$NORCHK(23,SRX),?38,$P(SRAO(2),"^",2)32 S SRX=$P(SRAO(3),"^") W !," 3. Total Cholesterol:",?25,$J(SRX,6),?35,$$NORCHK(24,SRX),?38,$P(SRAO(3),"^",2)33 S SRX=$P(SRAO(4),"^") W !," 4. Serum Triglyceride:",?25,$J(SRX,6),?35,$$NORCHK(22,SRX),?38,$P(SRAO(4),"^",2)34 S SRX=$P(SRAO(5),"^") W !," 5. Serum Potassium:",?25,$J(SRX,6),?35,$$NORCHK(5,SRX),?38,$P(SRAO(5),"^",2)35 S SRX=$P(SRAO(6),"^") W !," 6. Serum Bilirubin:",?25,$J(SRX,6),?35,$$NORCHK(14,SRX),?38,$P(SRAO(6),"^",2)36 S SRX=$P(SRAO(7),"^") W !," 7. Serum Creatinine:",?25,$J(SRX,6),?35,$$NORCHK(7,SRX),?38,$P(SRAO(7),"^",2)37 S SRX=$P(SRAO(8),"^") W !," 8. Serum Albumin:",?25,$J(SRX,6),?35,$$NORCHK(11,SRX),?38,$P(SRAO(8),"^",2)38 S SRX=$P(SRAO(9),"^") W !," 9. Hemoglobin:",?25,$J(SRX,6),?35,$$NORCHK(1,SRX),?38,$P(SRAO(9),"^",2)39 S SRX=$P(SRAO(10),"^") W !,"10. Hemoglobin A1c:",?25,$J(SRX,6),?35,$$NORCHK(27,SRX),?38,$P(SRAO(10),"^",2)29 DISP S SRPAGE="PAGE: 1",SRHDR(.5)="PREOPERATIVE LABORATORY RESULTS" D HDR^SROAUTL 30 W !," 1. HDL:",?25,$J($P(SRAO(1),"^"),6),?35,$P(SRAO(1),"^",2) 31 W !," 2. LDL:",?25,$J($P(SRAO(2),"^"),6),?35,$P(SRAO(2),"^",2) 32 W !," 3. Total Cholesterol:",?25,$J($P(SRAO(3),"^"),6),?35,$P(SRAO(3),"^",2) 33 W !," 4. Serum Triglyceride:",?25,$J($P(SRAO(4),"^"),6),?35,$P(SRAO(4),"^",2) 34 W !," 5. Serum Potassium:",?25,$J($P(SRAO(5),"^"),6),?35,$P(SRAO(5),"^",2) 35 W !," 6. Serum Bilirubin:",?25,$J($P(SRAO(6),"^"),6),?35,$P(SRAO(6),"^",2) 36 W !," 7. Serum Creatinine:",?25,$J($P(SRAO(7),"^"),6),?35,$P(SRAO(7),"^",2) 37 W !," 8. Serum Albumin:",?25,$J($P(SRAO(8),"^"),6),?35,$P(SRAO(8),"^",2) 38 W !," 9. Hemoglobin:",?25,$J($P(SRAO(9),"^"),6),?35,$P(SRAO(9),"^",2) 39 W !,"10. Hemoglobin A1c:",?25,$J($P(SRAO(10),"^"),6),?35,$P(SRAO(10),"^",2) 40 40 W !! F MOE=1:1:80 W "-" 41 41 Q … … 46 46 .K DA,DIE,DR S DA=SRCON,DIE=130,DR=S1_"////"_P1_";"_S2_"////"_P2 D ^DIE K DR 47 47 Q 48 NORCHK(SRAT,RESULT) ;49 I RESULT']""!(RESULT="NS") Q ""50 N NODE,LOW,HIGH,SRY51 S SRY="" S:"<>"[$E(RESULT) SRY=$E(RESULT),RESULT=$E(RESULT,2,99)52 S NODE=$G(^SRO(139.2,SRAT,2)),LOW=$P(NODE,"^",2),HIGH=$P(NODE,"^",3) Q:LOW']""!(HIGH']"")53 I SRY'="" Q $S(RESULT<(LOW+.01):"L",((RESULT>(HIGH-.01))&(SRY=">")):"H",1:"")54 Q $S(RESULT<LOW:"L",RESULT>HIGH:"H",1:"") -
FOIAVistA/tag/r/SURGERY-SR/SROACR2.m
r628 r636 1 SROACR2 ;BIR/SJA - OPERATIVE DATA, PAGE 2 ; 12/03/072 ;;3.0; Surgery ;**125,153,160 ,166**;24 Jun 93;Build 61 SROACR2 ;BIR/SJA - OPERATIVE DATA, PAGE 2 ;04/12/06 2 ;;3.0; Surgery ;**125,153,160**;24 Jun 93;Build 7 3 3 ; 4 4 I '$D(SRTN) W !!,"A Surgery Risk Assessment must be selected prior to using this option.",!!,"Press <RET> to continue " R X:DTIME G END … … 20 20 S SRSOUT=1 G END 21 21 Q 22 SEL S SRSOUT=0 W !!,"Select Cardiac ProceduresOperative Information to Edit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q22 SEL S SRSOUT=0 W !!,"Select Operative Information to Edit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q 23 23 Q:X="" S:X="a" X="A" I '$D(SRFLG),'$D(SRX(X)),(X'?1.2N1":"1.2N),X'="A" D HELP S SRR=1 Q 24 24 I X?1.2N1":"1.2N S Y=$P(X,":"),Z=$P(X,":",2) I Y<1!(Z>SRX)!(Y>Z) D HELP S SRR=1 Q -
FOIAVistA/tag/r/SURGERY-SR/SROALEC.m
r628 r636 1 SROALEC ;BIR/ADM - LIST OF ELIGIBLE CASES ;0 2/04/082 ;;3.0; Surgery ;**160 ,166**;24 Jun 93;Build 61 SROALEC ;BIR/ADM - LIST OF ELIGIBLE CASES ;05/04/07 2 ;;3.0; Surgery ;**160**;24 Jun 93;Build 7 3 3 S (GRAND,SRNEW,SRSOUT,TOT)=0,(SRHDR,SRPAGE)=1,SRTITLE="CASES ELIGIBLE FOR ASSESSMENT" K ^TMP("SRA",$J) 4 4 I SRFLG,SRASP S SRSPEC=$P(^SRO(137.45,SRASP,0),"^") … … 19 19 S SRCPLT=$P($G(^SRO(136,SRTN,10)),"^") I SRCPLT,'$$XL^SROAX(SRTN) Q 20 20 S SRA=$G(^SRF(SRTN,"RA")) 21 I SRAST=1 Q:'($P(SRA,"^",2)="N"!($P(SRA,"^",2)="C"))!'($P(SRA,"^",6)="Y")22 I SRAST=2 Q:'($P(SRA,"^",2)="N"!($P(SRA,"^",2)="C"))!'($P(SRA,"^",6)="N")23 I SRAST=3 Q:$P(SRA,"^",2)'=""24 21 I SRSP S SRSS=$P(^SRF(SRTN,0),"^",4),SRSS=$S(SRSS:$P(^SRO(137.45,SRSS,0),"^"),1:"SPECIALTY NOT ENTERED"),^TMP("SRA",$J,SRSS,SRSD,SRTN)=SRA Q 25 22 S ^TMP("SRA",$J,SRSD,SRTN)=SRA … … 36 33 Q 37 34 PRINT ; print case info 38 N SRDA,SRPROCS,SR SP1,SRY S SRPROCS=""39 I $Y+ 8>IOSL!SRNEW D PAGE I SRSOUT Q35 N SRDA,SRPROCS,SRY S SRPROCS="" 36 I $Y+6>IOSL!SRNEW D PAGE I SRSOUT Q 40 37 S SRA(0)=^SRF(SRTN,0),DFN=$P(SRA(0),"^") N I D DEM^VADPT S SRANM=VADM(1),SRASSN=VA("PID") K VADM 41 38 I $L(SRANM)>19 S SRANM=$P(SRANM,",")_","_$E($P(SRANM,",",2))_"." 42 S SRSP1="",X=$P(SRA(0),"^",4) S:X SRSP1=$P(^SRO(137.45,X,0),"^")43 39 S SROPER=$P(^SRF(SRTN,"OP"),"^") I $O(^SRF(SRTN,13,0)) S SROTHER=0 F I=0:0 S SROTHER=$O(^SRF(SRTN,13,SROTHER)) Q:'SROTHER D OTHER 44 40 K SROPS,MM,MMM S:$L(SROPER)<63 SROPS(1)=SROPER I $L(SROPER)>62 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM="" 45 41 S X=$P(SRA,"^"),SRSTATUS=$S(X="T":"TRANSMITTED",X="C":"COMPLETE",X="I":"INCOMPLETE",1:"NO ASSESSMENT"),Y=SRSD D D^DIQ S SRDT=$P(Y,"@") 46 I $Y+7>IOSL D PAGE I SRSOUT Q 47 W !,SRTN,?18,SRANM_" "_VA("PID"),?53,SRATYPE,?67,SRSTATUS,!,SRDT,?18,SROPS(1),! D 48 .I 'SRSP W $E(SRSP1,1,17) F I=2:1 W:$D(SROPS(I)) ?18,SROPS(I),! I '$D(SROPS(I)) W ! Q 49 .I SRSP F I=2:1 Q:'$D(SROPS(I)) W ?18,SROPS(I),! 42 I $Y+5>IOSL D PAGE I SRSOUT Q 43 W !,SRTN,?18,SRANM_" "_VA("PID"),?53,SRATYPE,?67,SRSTATUS,!,SRDT F I=1:1 Q:'$D(SROPS(I)) W ?18,SROPS(I),! 50 44 S SRY=$P($G(^SRO(136,SRTN,0)),"^",2) I SRY D CPT S SRPROCS=SRCODE 51 45 S SRDA=0 F S SRDA=$O(^SRO(136,SRTN,3,SRDA)) Q:'SRDA S SRY=$P($G(^SRO(136,SRTN,3,SRDA,0)),"^") I SRY D CPT D … … 76 70 W:$E(IOST)="P" !,?(80-$L(SRPRINT)\2),SRPRINT 77 71 W !!,?50,"'*' Denotes Eligible CPT Code" I SRSP,SRSS'="" W !,">>> "_SRSS 78 W !!,"CASE #",?18,"PATIENT",?53,"TYPE",?67,"STATUS",!,"OP DATE",?18,"OPERATION(S)",! W:'SRSP "SURG SPECIALTY",!F LINE=1:1:80 W "="72 W !!,"CASE #",?18,"PATIENT",?53,"TYPE",?67,"STATUS",!,"OP DATE",?18,"OPERATION(S)",! F LINE=1:1:80 W "=" 79 73 S SRHDR=0,SRNEW=0,SRPAGE=SRPAGE+1 80 74 Q -
FOIAVistA/tag/r/SURGERY-SR/SROALM.m
r628 r636 1 SROALM ;BIR/ADM - LIST OF ASSESSMENTS MISSING INFORMATION ; 12/05/072 ;;3.0; Surgery ;**38,50,88,142,153,160 ,166**;24 Jun 93;Build 61 SROALM ;BIR/ADM - LIST OF ASSESSMENTS MISSING INFORMATION ;02/08/07 2 ;;3.0; Surgery ;**38,50,88,142,153,160**;24 Jun 93;Build 7 3 3 S (GRAND,SRNEW,SRSOUT,TOT)=0,(SRHDR,SRPAGE)=1,SRTITLE="COMPLETED/TRANSMITTED ASSESSMENTS MISSING INFORMATION" K ^TMP("SRA",$J) 4 4 I SRFLG,SRASP S SRSPEC=$P(^SRO(137.45,SRASP,0),"^") … … 40 40 S CNT=1 W !,?5,"Missing information:" 41 41 I '$P($G(^SRO(136,SRTN,10)),"^")!('$P($G(^SRO(136,SRTN,0)),"^",2))!('$P($G(^SRO(136,SRTN,0)),"^",3)) W !,$J(CNT_". ",8),"The final coding for Procedure and Diagnosis is not complete." S CNT=CNT+1 42 F S SRFLD=$O(SRX(SRFLD)) Q:SRFLD="" D:$Y+5>IOSL PAGE Q:SRSOUT W !,$J(CNT_". ",8), $P(SRX(SRFLD),":") S CNT=CNT+142 F S SRFLD=$O(SRX(SRFLD)) Q:SRFLD="" D:$Y+5>IOSL PAGE Q:SRSOUT W !,$J(CNT_". ",8),SRX(SRFLD) S CNT=CNT+1 43 43 I 'SRSOUT W ! F LINE=1:1:80 W "-" 44 44 Q -
FOIAVistA/tag/r/SURGERY-SR/SROALOG.m
r628 r636 1 SROALOG ;BIR/MAM - ASSESSMENT LOG ;01/24/08 2 ;;3.0; Surgery ;**38,55,62,77,50,153,160,166**;24 Jun 93;Build 6 3 K SRMNA S (SRSOUT,SRFLG,SRSP,SRAST)=0,SRSRT=1 4 START G:SRSOUT END W @IOF K DIR S DIR("A",1)="List of Surgery Risk Assessments",DIR("A",2)="",DIR("A",3)=" 1. List of Incomplete Assessments" 5 S DIR("A",4)=" 2. List of Completed Assessments",DIR("A",5)=" 3. List of Transmitted Assessments" 6 S DIR("A",6)=" 4. List of Non-Assessed Major Surgical Cases",DIR("A",7)=" 5. List of All Major Surgical Cases" 7 S DIR("A",8)=" 6. List of All Surgical Cases",DIR("A",9)=" 7. List of Completed/Transmitted Assessments Missing Information" 8 S DIR("A",10)=" 8. List of 1-Liner Cases Missing Information",DIR("A",11)=" 9. List of Eligible Cases" 9 S DIR("A",12)=" 10. List of Cases With No CPT Codes",DIR("A",13)=" 11. Summary List of Assessed Cases" 10 S DIR("A",14)="",DIR("A")="Select the Number of the Report Desired" 11 S DIR(0)="NO^1:11" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y S SRSOUT=1 G END 1 SROALOG ;BIR/MAM - ASSESSMENT LOG ;01/22/07 2 ;;3.0; Surgery ;**38,55,62,77,50,153,160**;24 Jun 93;Build 7 3 K SRMNA S (SRSOUT,SRFLG,SRSP)=0 4 START G:SRSOUT END W @IOF,!,"List of Surgery Risk Assessments",!!," 1. List of Incomplete Assessments" 5 W !," 2. List of Completed Assessments",!," 3. List of Transmitted Assessments" 6 W !," 4. List of Non-Assessed Major Surgical Cases",!," 5. List of All Major Surgical Cases" 7 W !," 6. List of All Surgical Cases",!," 7. List of Completed/Transmitted Assessments Missing Information" 8 W !," 8. List of 1-Liner Cases Missing Information",!," 9. List of Eligible Cases" 9 W !!,"Select the Number of the Report Desired: " R X:DTIME I '$T!("^"[X) S SRSOUT=1 G END 10 I X<1!(X>9)!(X\1'=X) D HELP G START 12 11 S SREPORT=X 13 DATE I SREPORT=3 D DSORT G:SRSOUT END 14 D DATE^SROUTL(.SRSD,.SRED,.SRSOUT) G:SRSOUT END 15 I SREPORT=9 D TYPE9 I SRSOUT G END 16 I SREPORT=3 D TYPE3 I SRSOUT G END 12 DATE D DATE^SROUTL(.SRSD,.SRED,.SRSOUT) G:SRSOUT END 17 13 D SEL G:SRSOUT END 18 14 N SRINSTP S SRINST=$$INST^SROUTL0() G:SRINST="^" END S SRINSTP=$P(SRINST,"^"),SRINST=$S(SRINST["ALL DIVISIONS":SRINST,1:$P(SRINST,"^",2)) 19 15 I SREPORT<7 W @IOF,!,"This report is designed to print to your terminal screen or a printer. When",!,"using a printer, a 132 column format is used.",! 20 16 K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Print the List of Assessments to which Device: ",%ZIS="QM" D ^%ZIS I POP S SRSOUT=1 G END 21 I $D(IO("Q")) K IO("Q") D S ZTREQ="@" D ^%ZTLOAD G END 22 .S ZTRTN="EN^SROALOG",ZTDESC="List of Surgery Risk Assessments" 23 .S (ZTSAVE("SRSD"),ZTSAVE("SRED"),ZTSAVE("SREPORT"),ZTSAVE("SRASP"),ZTSAVE("SRFLG"),ZTSAVE("SRSP"),ZTSAVE("SRINSTP"),ZTSAVE("SRAST"),ZTSAVE("SRSRT"))="" 17 I $D(IO("Q")) K IO("Q") S ZTRTN="EN^SROALOG",ZTDESC="List of Surgery Risk Assessments",(ZTSAVE("SRSD"),ZTSAVE("SRED"),ZTSAVE("SREPORT"),ZTSAVE("SRASP"),ZTSAVE("SRFLG"),ZTSAVE("SRSP"),ZTSAVE("SRINSTP"))="",ZTREQ="@" D ^%ZTLOAD G END 24 18 EN ; entry when queued 25 19 N SRFRTO S Y=SRSD X ^DD("DD") S SRFRTO="FROM: "_Y_" TO: ",Y=SRED X ^DD("DD") S SRFRTO=SRFRTO_Y … … 34 28 I SREPORT=8 D ^SROALMN G END 35 29 I SREPORT=9 D ^SROALEC G END 36 I SREPORT=10 D ^SROALNC G END37 I SREPORT=11 D ^SROALSL G END38 30 D:SRSP ^SROALSS D:'SRSP ^SROALST 39 END I 'SRSOUT,$E(IOST)'="P" W !!,"Press ENTERto continue " R X:DTIME31 END I 'SRSOUT,$E(IOST)'="P" W !!,"Press <RET> to continue " R X:DTIME 40 32 W:$E(IOST)="P" @IOF K ^TMP("SRA",$J) I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q 41 D ^%ZISC K SRTN ,SRAST,SRSRTW @IOF D ^SRSKILL33 D ^%ZISC K SRTN W @IOF D ^SRSKILL 42 34 Q 43 TYPE3 ; select type of eligible cases 44 W ! K DIR S DIR("A",1)="Print which Transmitted Cases ?",DIR("A",2)="",DIR("A",3)=" 1. Assessed Cases Only" 45 S DIR("A",4)=" 2. Excluded Cases Only",DIR("A",5)=" 3. Both Assessed and Excluded",DIR("A",6)="" 46 S DIR("A")="Select Number",DIR("B")=1,DIR(0)="N^1:3" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 47 S SRAST=Y 48 Q 49 TYPE9 ; select type of transmitted case 50 W ! K DIR S DIR("A",1)="Print which Eligible Cases ?",DIR("A",2)="",DIR("A",3)=" 1. Assessed Cases Only" 51 S DIR("A",4)=" 2. Excluded Cases Only",DIR("A",5)=" 3. Non-Assessed Cases only",DIR("A",6)=" 4. All Cases",DIR("A",7)="" 52 S DIR("A")="Select Number",DIR("B")=1,DIR(0)="N^1:4" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 53 S SRAST=Y 54 Q 55 DSORT ; sort by op date or transmit date 56 W ! K DIR S DIR("A",1)="Print by Date of Operation or by Date of Transmission ?",DIR("A",2)="",DIR("A",3)=" 1. Date of Operation" 57 S DIR("A",4)=" 2. Date of Transmission",DIR("A",5)="",DIR("A")="Select Number",DIR("B")=1,DIR(0)="N^1:2" 58 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 59 S SRSRT=Y 35 HELP W !!,"Select the number corresponding to the type of report you want to print.",!!,"Press <RET> to continue " R X:DTIME I '$T!(X["^") S SRSOUT=1 60 36 Q 61 37 SEL ; select specialty 62 W ! K DIR S DIR(0)="YA",DIR("A")="Print by Surgical Specialty ? ",DIR("B")="YES" 63 S DIR("?",1)="Enter YES to print the report by surgical specialty, or NO to print",DIR("?")="the report listing all surgical cases." 64 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q 65 Q:'Y 66 SEL1 S SRSP=1 W ! K DIR S DIR(0)="YA",DIR("A")="Print report for ALL specialties ? ",DIR("B")="YES" 67 S DIR("?",1)="Enter YES to print the report for all surgical specialties, or NO to",DIR("?")="print the report for a specific surgical specialty." 68 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q 69 I 'Y W ! S DIC("S")="I '$P(^(0),""^"",3)",DIC("A")="Print the Report for which Surgical Specialty: ",DIC=137.45,DIC(0)="QEAMZ" D ^DIC K DIC I Y>0 S SRASP=+Y,SRFLG=1 Q 38 W !!,"Print by Surgical Specialty ? YES// " R X:DTIME S:'$T X="^" I X="^" S SRSOUT=1 Q 39 S X=$E(X) I "YyNn"'[X W !!,"Enter <RET> to print the report by surgical specialty, or 'N' to print",!,"the report listing all surgical cases." G SEL 40 Q:"Yy"'[X 41 SEL1 S SRSP=1 W !!,"Print report for ALL specialties ? YES// " R X:DTIME S:'$T X="^" I X="^" S SRSOUT=1 Q 42 S X=$E(X) I "YyNn"'[X W !!,"Enter <RET> to print the report for all surgical specialties, or 'N' to ",!,"print the report for a specific surgical specialty." G SEL1 43 I "Yy"'[X W ! S DIC("S")="I '$P(^(0),""^"",3)",DIC("A")="Print the Report for which Surgical Specialty: ",DIC=137.45,DIC(0)="QEAMZ" D ^DIC K DIC I Y>0 S SRASP=+Y,SRFLG=1 Q 70 44 I Y'>0 S SRSOUT=1 Q 71 45 Q -
FOIAVistA/tag/r/SURGERY-SR/SROALT.m
r628 r636 1 SROALT ;BIR/MAM - TRANSMITTED ASSESSMENTS ;01/07/08 2 ;;3.0; Surgery ;**38,50,142,153,160,166**;24 Jun 93;Build 6 3 S SRFRTO=$S(SRSRT=2:"TRANSMISSION DATES ",1:"OPERATION DATES ")_SRFRTO 1 SROALT ;BIR/MAM - TRANSMITTED ASSESSMENTS ;01/18/07 2 ;;3.0; Surgery ;**38,50,142,153,160**;24 Jun 93;Build 7 4 3 I $E(IOST)="P" D ^SROALTP Q 5 4 S SRSOUT=0 D HDR 6 I SRSRT=2 F S SRSD=$O(^SRF("AT",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AT",SRSD,SRTN)) Q:'SRTN!SRSOUT D 7 .S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^")="T",$D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D SET 8 I SRSRT=1 F S SRSD=$O(^SRF("AC",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",SRSD,SRTN)) Q:'SRTN!SRSOUT D 9 .S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^")="T",$D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D SET 5 F S SRSD=$O(^SRF("AC",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",SRSD,SRTN)) Q:'SRTN!SRSOUT S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^")="T",$D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D SET 10 6 Q 11 7 SET ; print assessments 12 K SRCPTT ,SREX S SRCPTT="NOT ENTERED",SREX=""8 K SRCPTT S SRCPTT="NOT ENTERED" 13 9 I $Y+5>IOSL D PAGE I SRSOUT Q 14 S SR("RA")=^SRF(SRTN,"RA")15 I SRAST=1 Q:'($P(SR("RA"),"^",2)="N"!($P(SR("RA"),"^",2)="C"))!'($P(SR("RA"),"^",6)="Y")16 I SRAST=2 Q:'($P(SR("RA"),"^",2)="N"!($P(SR("RA"),"^",2)="C"))!'($P(SR("RA"),"^",6)="N")17 S SRAT="",Y=$E($P(SR("RA"),"^",8),1,7) S:Y="" Y=$E($P(SR("RA"),"^",4),1,7) I Y D D^DIQ S SRAT=Y18 10 S SRA(0)=^SRF(SRTN,0),DFN=$P(SRA(0),"^") N I D DEM^VADPT S SRANM=VADM(1),SRASSN=VA("PID") K VADM 19 11 I $L(SRANM)>19 S SRANM=$P(SRANM,",")_","_$E($P(SRANM,",",2))_"." 20 12 S SROPER=$P(^SRF(SRTN,"OP"),"^") I $O(^SRF(SRTN,13,0)) S SROTHER=0 F I=0:0 S SROTHER=$O(^SRF(SRTN,13,SROTHER)) Q:'SROTHER D OTHER 21 S X=$P( SR("RA"),"^",2) I X="C" S SROPER="* "_SROPER13 S X=$P($G(^SRF(SRTN,"RA")),"^",2) I X="C" S SROPER="* "_SROPER 22 14 K SROPS,MM,MMM S:$L(SROPER)<34 SROPS(1)=SROPER I $L(SROPER)>33 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM="" 23 15 S SRSS=$P(SRA(0),"^",4),SRSS=$S(SRSS:$P(^SRO(137.45,SRSS,0),"^"),1:"SPECIALTY NOT ENTERED") 24 16 D TECH^SROPRIN 25 17 S Y=$P(SRA(0),"^",9) D D^DIQ S SRDT=$P(Y,"@") 26 S X=$P(SR("RA"),"^",7) I X'="" S SREX="EXCLUDED" 27 W !,SRTN,?20,SRANM_" "_VA("PID"),?55,$P(SRSS,"("),!,SRDT,?20,SROPS(1),?55,SRTECH,!,SRAT I $D(SROPS(2)) W ?20,SROPS(2) I $D(SROPS(3)) W !,?20,SROPS(3) 28 N I,SRPROC,SRL S SRL=48 D CPTS^SROAUTL0 W:$D(SROPS(2)) ! W SREX,?20,"CPT Codes: " 18 W !,SRTN,?20,SRANM_" "_VA("PID"),?55,$P(SRSS,"("),!,SRDT,?20,SROPS(1),?55,SRTECH I $D(SROPS(2)) W !,?20,SROPS(2) I $D(SROPS(3)) W !,?20,SROPS(3) 19 N I,SRPROC,SRL S SRL=48 D CPTS^SROAUTL0 W !,?20,"CPT Codes: " 29 20 F I=1:1 Q:'$D(SRPROC(I)) W:I=1 ?31,SRPROC(I) W:I'=1 !,?31,SRPROC(I) 30 21 W ! F LINE=1:1:80 W "-" … … 40 31 PAGE W !!,"Press <RET> to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q 41 32 I X["?" W !!,"If you want to continue listing incomplete assessments, enter <RET>. Enter",!,"'^' to return to the menu." G PAGE 42 HDR W @IOF,!,?26,"TRANSMITTED RISK ASSESSMENTS",!,?(80-$L(SRFRTO)\2),SRFRTO,!!,"ASSESSMENT #",?20,"PATIENT",?55,"SURGICAL SPECIALTY",!,"OPERATION DATE",?20,"OPERATION(S)",?55,"ANESTHESIA TECHNIQUE",! ,"TRANSMISSION DATE",!F LINE=1:1:80 W "="33 HDR W @IOF,!,?26,"TRANSMITTED RISK ASSESSMENTS",!,?(80-$L(SRFRTO)\2),SRFRTO,!!,"ASSESSMENT #",?20,"PATIENT",?55,"SURGICAL SPECIALTY",!,"OPERATION DATE",?20,"OPERATION(S)",?55,"ANESTHESIA TECHNIQUE",! F LINE=1:1:80 W "=" 43 34 Q -
FOIAVistA/tag/r/SURGERY-SR/SROALTP.m
r628 r636 1 SROALTP ;BIR/MAM - TRANSMITTED ASSESSMENTS (PRINTER) ;01/ 07/082 ;;3.0; Surgery ;**32,50,142,153,160 ,166**;24 Jun 93;Build 61 SROALTP ;BIR/MAM - TRANSMITTED ASSESSMENTS (PRINTER) ;01/18/07 2 ;;3.0; Surgery ;**32,50,142,153,160**;24 Jun 93;Build 7 3 3 S SRPAGE=1,(SRSOUT,SRDFN)=0 D HDR Q:SRSOUT 4 I SRSRT=2 F S SRSD=$O(^SRF("AT",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AT",SRSD,SRTN)) Q:'SRTN!SRSOUT D 5 .S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^")="T",$D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D SET 6 I SRSRT=1 F S SRSD=$O(^SRF("AC",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",SRSD,SRTN)) Q:'SRTN!SRSOUT D 7 .S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^")="T",$D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D SET 4 F S SRSD=$O(^SRF("AC",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",SRSD,SRTN)) Q:'SRTN!SRSOUT S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^")="T",$D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D SET 8 5 Q 9 6 SET ; print assessments 10 K SRCPTT ,SREX S SRCPTT="NOT ENTERED",SREX=""7 K SRCPTT S SRCPTT="NOT ENTERED" 11 8 I $Y+5>IOSL S SRPAGE=SRPAGE+1 D HDR I SRSOUT Q 12 S SR("RA")=^SRF(SRTN,"RA")13 I SRAST=1 Q:'($P(SR("RA"),"^",2)="N"!($P(SR("RA"),"^",2)="C"))!'($P(SR("RA"),"^",6)="Y")14 I SRAST=2 Q:'($P(SR("RA"),"^",2)="N"!($P(SR("RA"),"^",2)="C"))!'($P(SR("RA"),"^",6)="N")15 S SRAT="",Y=$E($P(SR("RA"),"^",8),1,7) S:Y="" Y=$E($P(SR("RA"),"^",4),1,7) I Y D D^DIQ S SRAT=Y16 9 S SRA(0)=^SRF(SRTN,0),DFN=$P(SRA(0),"^") N I D DEM^VADPT S SRANM=VADM(1),SRASSN=VA("PID") K VADM 17 10 S SROPER=$P(^SRF(SRTN,"OP"),"^") I $O(^SRF(SRTN,13,0)) S SROTHER=0 F S SROTHER=$O(^SRF(SRTN,13,SROTHER)) Q:'SROTHER D OTHER 18 S X=$P( SR("RA"),"^",2) I X="C" S SROPER="* "_SROPER11 S X=$P($G(^SRF(SRTN,"RA")),"^",2) I X="C" S SROPER="* "_SROPER 19 12 K SROPS,MM,MMM S:$L(SROPER)<81 SROPS(1)=SROPER I $L(SROPER)>80 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM="" 20 13 S SRSS=$P(SRA(0),"^",4),SRSS=$S(SRSS:$P(^SRO(137.45,SRSS,0),"^"),1:"SPECIALTY NOT ENTERED") … … 22 15 D TECH^SROPRIN 23 16 S Y=$P(SRA(0),"^",9) D D^DIQ S SRDT=$P(Y,"@") 24 S X=$P(SR("RA"),"^",7) I X'="" S SREX="EXCLUDED" 25 W !,SRTN,?20,SRANM_" "_VA("PID"),?67,$P(SRSS,"("),?107,SRTECH,!,SRDT,?20,SROPS(1),?107,SRAT I $D(SROPS(2)) W !,?20,SROPS(2) I $D(SROPS(3)) W !,?20,SROPS(3) I $D(SROPS(4)) W !,?20,SROPS(4) 26 N I,SRPROC,SRL S SRL=100 D CPTS^SROAUTL0 W !,SREX,?20,"CPT Codes: " 17 W !,SRTN,?20,SRANM_" "_VA("PID"),?67,$P(SRSS,"("),?107,SRTECH,!,SRDT,?20,SROPS(1) I $D(SROPS(2)) W !,?20,SROPS(2) I $D(SROPS(3)) W !,?20,SROPS(3) I $D(SROPS(4)) W !,?20,SROPS(4) 18 N I,SRPROC,SRL S SRL=100 D CPTS^SROAUTL0 W !,?20,"CPT Codes: " 27 19 F I=1:1 Q:'$D(SRPROC(I)) W:I=1 ?31,SRPROC(I) W:I'=1 !,?31,SRPROC(I) 28 20 W ! F LINE=1:1:132 W "-" … … 40 32 W:$Y @IOF W !,?52,"TRANSMITTED RISK ASSESSMENTS",?120,"PAGE "_SRPAGE,!,?(132-$L(SRINST)\2),SRINST,!,?58,"SURGERY SERVICE",?100,"DATE REVIEWED:" 41 33 W !,?(132-$L(SRFRTO)\2),SRFRTO,?100,"REVIEWED BY:" 42 W !!,"ASSESSMENT #",?20,"PATIENT",?67,"SURGICAL SPECIALTY",?107,"ANESTHESIA TECHNIQUE",!,"OPERATION DATE",?20,"OPERATIVE PROCEDURE(S)", ?107,"TRANSMISSION DATE",! F LINE=1:1:132 W "="34 W !!,"ASSESSMENT #",?20,"PATIENT",?67,"SURGICAL SPECIALTY",?107,"ANESTHESIA TECHNIQUE",!,"OPERATION DATE",?20,"OPERATIVE PROCEDURE(S)",! F LINE=1:1:132 W "=" 43 35 Q -
FOIAVistA/tag/r/SURGERY-SR/SROALTS.m
r628 r636 1 SROALTS ;BIR/MAM - TRANSMITTED ASSESSMENTS ;01/07/08 2 ;;3.0; Surgery ;**38,50,142,153,160,166**;24 Jun 93;Build 6 3 S SRFRTO=$S(SRSRT=2:"TRANSMISSION DATES ",1:"OPERATION DATES ")_SRFRTO 1 SROALTS ;BIR/MAM - TRANSMITTED ASSESSMENTS ;01/18/07 2 ;;3.0; Surgery ;**38,50,142,153,160**;24 Jun 93;Build 7 4 3 I $E(IOST)="P" D ^SROALTSP Q 5 4 S SRSOUT=0 D HDR 6 I SRSRT=2 F S SRSD=$O(^SRF("AT",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AT",SRSD,SRTN)) Q:'SRTN!SRSOUT D 7 .S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^")="T",$D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D UTL 8 I SRSRT=1 F S SRSD=$O(^SRF("AC",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",SRSD,SRTN)) Q:'SRTN!SRSOUT D 9 .S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^")="T",$D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D UTL 5 F S SRSD=$O(^SRF("AC",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",SRSD,SRTN)) Q:'SRTN!SRSOUT S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^")="T",$D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D UTL 10 6 S SRSS="" F S SRSS=$O(^TMP("SRA",$J,SRSS)) Q:SRSS=""!SRSOUT D SS S SRTN=0 F J=0:0 S SRTN=$O(^TMP("SRA",$J,SRSS,SRTN)) Q:'SRTN!SRSOUT D SET 11 7 I '$D(^TMP("SRA",$J)) W $$NODATA^SROUTL0() … … 14 10 I SRFLG,$P(^SRF(SRTN,0),"^",4)'=SRASP Q 15 11 S SRSS=$P(^SRF(SRTN,0),"^",4),SRSS=$S(SRSS:$P(^SRO(137.45,SRSS,0),"^"),1:"SPECIALTY NOT ENTERED") 16 S SR("RA")=^SRF(SRTN,"RA")17 I SRAST=1 Q:'($P(SR("RA"),"^",2)="N"!($P(SR("RA"),"^",2)="C"))!'($P(SR("RA"),"^",6)="Y")18 I SRAST=2 Q:'($P(SR("RA"),"^",2)="N"!($P(SR("RA"),"^",2)="C"))!'($P(SR("RA"),"^",6)="N")19 12 S ^TMP("SRA",$J,SRSS,SRTN)="" 20 13 Q 21 14 SET ; print assessments 22 K SRCPTT ,SREX S SRCPTT="NOT ENTERED",SREX=""15 K SRCPTT S SRCPTT="NOT ENTERED" 23 16 I $Y+5>IOSL D PAGE I SRSOUT Q 24 S SR("RA")=^SRF(SRTN,"RA") 25 S SRAT="",Y=$E($P(SR("RA"),"^",8),1,7) S:Y="" Y=$E($P(SR("RA"),"^",4),1,7) I Y D D^DIQ S SRAT=Y 17 S SR("RA")=^SRF(SRTN,"RA"),SRAT="",Y=$E($P(SR("RA"),"^",4),1,7) I Y D D^DIQ S SRAT=Y 26 18 S SRA(0)=^SRF(SRTN,0),DFN=$P(SRA(0),"^") N I D DEM^VADPT S SRANM=VADM(1),SRASSN=VA("PID") K VADM 27 19 I $L(SRANM)>19 S SRANM=$P(SRANM,",")_","_$E($P(SRANM,",",2))_"." 28 20 S SROPER=$P(^SRF(SRTN,"OP"),"^") I $O(^SRF(SRTN,13,0)) S SROTHER=0 F I=0:0 S SROTHER=$O(^SRF(SRTN,13,SROTHER)) Q:'SROTHER D OTHER 29 S X=$P( SR("RA"),"^",2) I X="C" S SROPER="* "_SROPER21 S X=$P($G(^SRF(SRTN,"RA")),"^",2) I X="C" S SROPER="* "_SROPER 30 22 K SROPS,MM,MMM S:$L(SROPER)<34 SROPS(1)=SROPER I $L(SROPER)>33 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM="" 31 23 D TECH^SROPRIN 32 24 S Y=$P(SRA(0),"^",9) D D^DIQ S SRDT=$P(Y,"@") 33 S X=$P(SR("RA"),"^",7) I X'="" S SREX="EXCLUDED"34 25 W !,SRTN,?20,SRANM_" "_VA("PID"),?55,SRAT,!,SRDT,?20,SROPS(1),?55,SRTECH S SRAO=1 F I=0:0 S SRAO=$O(SROPS(SRAO)) Q:'SRAO W !,?20,SROPS(SRAO) 35 N I,SRPROC,SRL S SRL=48 D CPTS^SROAUTL0 W !, SREX,?20,"CPT Codes: "26 N I,SRPROC,SRL S SRL=48 D CPTS^SROAUTL0 W !,?20,"CPT Codes: " 36 27 F I=1:1 Q:'$D(SRPROC(I)) W:I=1 ?31,SRPROC(I) W:I'=1 !,?31,SRPROC(I) 37 28 W ! F LINE=1:1:80 W "-" -
FOIAVistA/tag/r/SURGERY-SR/SROALTSP.m
r628 r636 1 SROALTSP ;BIR/MAM - TRANSMITTED ASSESSMENTS (PRINTER) ;01/ 07/082 ;;3.0; Surgery ;**32,50,142,153,160 ,166**;24 Jun 93;Build 61 SROALTSP ;BIR/MAM - TRANSMITTED ASSESSMENTS (PRINTER) ;01/18/07 2 ;;3.0; Surgery ;**32,50,142,153,160**;24 Jun 93;Build 7 3 3 K ^TMP("SRA",$J) S SRPAGE=0,(SRSOUT,SRDFN)=0 D HDR Q:SRSOUT 4 I SRSRT=2 F S SRSD=$O(^SRF("AT",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AT",SRSD,SRTN)) Q:'SRTN!SRSOUT D 5 .S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^")="T",$D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D UTL 6 I SRSRT=1 F S SRSD=$O(^SRF("AC",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",SRSD,SRTN)) Q:'SRTN!SRSOUT D 7 .S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^")="T",$D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D UTL 4 F S SRSD=$O(^SRF("AC",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT S SRTN=0 F S SRTN=$O(^SRF("AC",SRSD,SRTN)) Q:'SRTN!SRSOUT S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^")="T",$D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D UTL 8 5 S SRSS="" F S SRSS=$O(^TMP("SRA",$J,SRSS)) Q:SRSS=""!SRSOUT D SS S SRTN=0 F S SRTN=$O(^TMP("SRA",$J,SRSS,SRTN)) Q:'SRTN!SRSOUT D SET 9 6 I '$D(^TMP("SRA",$J)) W $$NODATA^SROUTL0() … … 13 10 S SRSS=$P(^SRF(SRTN,0),"^",4),SRSS=$S(SRSS:$P(^SRO(137.45,SRSS,0),"^"),1:"SPECIALTY NOT ENTERED") 14 11 S TYPE=$P(SR("RA"),"^",2) I SRSS="SPECIALTY NOT ENTERED",TYPE="C" S SRSS="N/A" 15 S SR("RA")=^SRF(SRTN,"RA")16 I SRAST=1 Q:'($P(SR("RA"),"^",2)="N"!($P(SR("RA"),"^",2)="C"))!'($P(SR("RA"),"^",6)="Y")17 I SRAST=2 Q:'($P(SR("RA"),"^",2)="N"!($P(SR("RA"),"^",2)="C"))!'($P(SR("RA"),"^",6)="N")18 12 S ^TMP("SRA",$J,SRSS,SRTN)="" 19 13 Q 20 14 SET ; print assessments 21 K SRCPTT ,SREX S SRCPTT="NOT ENTERED",SREX=""15 K SRCPTT S SRCPTT="NOT ENTERED" 22 16 I $Y+5>IOSL D HDR I SRSOUT Q 23 S SR("RA")=^SRF(SRTN,"RA") 24 S SRAT="",Y=$E($P(SR("RA"),"^",8),1,7) S:Y="" Y=$E($P(SR("RA"),"^",4),1,7) I Y D D^DIQ S SRAT=Y 17 S SR("RA")=^SRF(SRTN,"RA"),SRAT="",Y=$E($P(SR("RA"),"^",4),1,7) I Y D D^DIQ S SRAT=Y 25 18 S SRA(0)=^SRF(SRTN,0),DFN=$P(SRA(0),"^") N I D DEM^VADPT S SRANM=VADM(1),SRASSN=VA("PID") K VADM 26 19 S SROPER=$P(^SRF(SRTN,"OP"),"^") I $O(^SRF(SRTN,13,0)) S SROTHER=0 F S SROTHER=$O(^SRF(SRTN,13,SROTHER)) Q:'SROTHER D OTHER 27 S X=$P( SR("RA"),"^",2) I X="C" S SROPER="* "_SROPER20 S X=$P($G(^SRF(SRTN,"RA")),"^",2) I X="C" S SROPER="* "_SROPER 28 21 K SROPS,MM,MMM S:$L(SROPER)<81 SROPS(1)=SROPER I $L(SROPER)>80 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM="" 29 22 D TECH^SROPRIN 30 23 S Y=$P(SRA(0),"^",9) D D^DIQ S SRDT=$P(Y,"@") 31 S X=$P(SR("RA"),"^",7) I X'="" S SREX="EXCLUDED"32 24 W !,SRTN,?20,SRANM_" "_VA("PID"),?67,SRAT,?107,SRTECH,!,SRDT,?20,SROPS(1) S SRAO=1 F S SRAO=$O(SROPS(SRAO)) Q:'SRAO W !,?20,SROPS(SRAO) 33 N I,SRPROC,SRL S SRL=100 D CPTS^SROAUTL0 W !, SREX,?20,"CPT Codes: "25 N I,SRPROC,SRL S SRL=100 D CPTS^SROAUTL0 W !,?20,"CPT Codes: " 34 26 F I=1:1 Q:'$D(SRPROC(I)) W:I=1 ?31,SRPROC(I) W:I'=1 !,?31,SRPROC(I) 35 27 D LINE -
FOIAVistA/tag/r/SURGERY-SR/SROAMEAS.m
r628 r636 1 1 SROAMEAS ;BIR/MAM - INPUT TRANSFORMS, HEIGHT & WEIGHT ;03/20/06 2 ;;3.0; Surgery ;**38,125,153 ,166**;24 Jun 93;Build 62 ;;3.0; Surgery ;**38,125,153**;24 Jun 93;Build 11 3 3 H Q:'$D(X) I X'?.N1"C"&(X'?.N1"c"),(+X'=X) K X Q 4 4 I +X=X S X=X+.5\1 I X'>47.9!(X'<86.1) K X Q … … 11 11 I X?.N1"K",(X'>22.9!(X'<318.1)) K X 12 12 Q 13 HWC ; reject NS entry if the case is cardiac one14 S X=$S(X="ns":"NS",1:X)15 I $P($G(^SRF($S($G(SRTN):SRTN,1:DA),"RA")),"^",2)="C",X="NS" S X=""16 Q -
FOIAVistA/tag/r/SURGERY-SR/SROAMIS.m
r628 r636 1 SROAMIS ;B IR/MAM - ANESTHESIA AMIS REPORT ;11/26/072 ;;3.0; Surgery ;**22,34,38,77,50,86 ,166**;24 Jun 93;Build 61 SROAMIS ;B'HAM ISC/MAM - ANESTHESIA AMIS REPORT ; [ 12/16/98 2:06 PM ] 2 ;;3.0; Surgery ;**22,34,38,77,50,86**;24 Jun 93 3 3 UTL ; set up ^TMP("SROAMIS",$J 4 4 S PRIN=$P($G(^SRF(SRDFN,.3)),"^",8) I PRIN="" S PRIN="O" … … 33 33 Q 34 34 EN ; entry for SROAMIS option 35 W @IOF,!,"Anesthesia AMIS",!!,"This report is no longer available.",! 36 K DIR S DIR(0)="E" D ^DIR K DIR D END 37 Q 35 W @IOF,!,"Anesthesia AMIS",! 38 36 DATE D DATE^SROUTL(.SDATE,.EDATE,.SRSOUT) G:SRSOUT END S SRD=SDATE-.0001 39 37 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)) -
FOIAVistA/tag/r/SURGERY-SR/SROAOP.m
r628 r636 1 SROAOP ;BIR/MAM - ENTER OPERATION INFO ; 11/27/072 ;;3.0; Surgery ;**19,38,47,63,67,81,86,97,100,125,142,153,160 ,166**;24 Jun 93;Build 61 SROAOP ;BIR/MAM - ENTER OPERATION INFO ;04/24/07 2 ;;3.0; Surgery ;**19,38,47,63,67,81,86,97,100,125,142,153,160**;24 Jun 93;Build 7 3 3 I '$D(SRTN) W !!,"A Surgery Risk Assessment must be selected prior to using this option.",!!,"Press <RET> to continue " R X:DTIME G END 4 4 S SRSOUT=0,SRSUPCPT=1 D ^SROAUTL … … 65 65 S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<57 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM 66 66 Q 67 ANES N SRANE,SRNEW 68 I $P(SRAO(10),"^")="NOT ENTERED",'$O(^SRF(SRTN,6,0)) D Q 69 .K DIR S DIR("A")="Select ANESTHESIA TECHNIQUE: ",DIR(0)="130.06,.01OA" D ^DIR K DIR S SRANE=Y I $D(DTOUT)!$D(DUOUT)!(Y="") Q 70 .K DD,DO S DIC="^SRF(SRTN,6,",X=SRANE,DIC(0)="L" D FILE^DICN K DIC,DD,DO I '+Y Q 71 .S SRNEW=+Y 72 .K DA,DIE,DR S DA=SRNEW,DA(1)=SRTN,DIE="^SRF(SRTN,6,",DR=".05T;42T" D ^DIE 73 K DR,DIE,DA S DA=SRTN,DR=".37T",DR(2,130.06)=".01T;.05T;42T",DIE=130 D ^DIE K DR 67 ANES K DR,DIE,DA S DA=SRTN,DR=".37T",DR(2,130.06)=".01T;.05T;42T",DIE=130 D ^DIE K DR 74 68 Q -
FOIAVistA/tag/r/SURGERY-SR/SROAPAS.m
r628 r636 1 SROAPAS ;BIR/MAM - PRINT A COMPLETE ASSESSMENT ; 03/03/082 ;;3.0; Surgery ;**38,47,81,88,111,112,100,125,153 ,166**;24 Jun 93;Build 61 SROAPAS ;BIR/MAM - PRINT A COMPLETE ASSESSMENT ; [ 04/13/04 2:50 PM ] 2 ;;3.0; Surgery ;**38,47,81,88,111,112,100,125,153**;24 Jun 93;Build 11 3 3 S SRSOUT=0,SRPG=0,SR("RA")=$G(^SRF(SRTN,"RA")),SRATYPE=$P(SR("RA"),"^",2) F I=200:1:208,200.1 S SRA(I)=$G(^SRF(SRTN,I)) 4 4 S SRA("OP")=^SRF(SRTN,"OP"),SRA("CON")=$G(^SRF(SRTN,"CON")) … … 48 48 S (X,Z)=SRPTMODT(17) S:X'="" Z=$P(X,"@")_" "_$E($P(X,"@",2),1,5) W !,"Discharged/Transferred to Chronic Care:",?47,Z 49 49 W !,"In/Out-Patient Status:",?47,$S($P($G(^SRF(SRTN,0)),"^",12)="I":"INPATIENT",$P($G(^SRF(SRTN,0)),"^",12)="O":"OUTPATIENT",1:"") 50 S Y=$P($G(^SRF(SRTN,209)),"^",17) X ^DD("DD") W !,"Date Surgery Consult Requested:",?47,Y51 S Y=$P($G(^SRF(SRTN,209)),"^",15) X ^DD("DD") W !,"Surgery Consult Date:",?47,Y52 50 I $E(IOST)="P" W ! F MOE=1:1:80 W "-" 53 51 I $E(IOST)'="P" D PAGE I SRSOUT G END … … 61 59 END Q:$D(SRABATCH) I 'SRSOUT,$E(IOST)'="P" W !!,"Press <RET> to continue " R X:DTIME 62 60 W:$E(IOST)="P" @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q 63 D ^%ZISC K SR OETH,SRTN W @IOF D ^SRSKILL61 D ^%ZISC K SRTN W @IOF D ^SRSKILL 64 62 Q 65 63 ; -
FOIAVistA/tag/r/SURGERY-SR/SROAPCA1.m
r628 r636 1 SROAPCA1 ;BIR/MAM - PRINT CARDIAC CATH INFO ;0 2/05/082 ;;3.0; Surgery ;**38,63,71,88,95,125,142,153 ,166**;24 Jun 93;Build 61 SROAPCA1 ;BIR/MAM - PRINT CARDIAC CATH INFO ;04/05/04 2 ;;3.0; Surgery ;**38,63,71,88,95,125,142,153**;24 Jun 93;Build 11 3 3 N SRX F I=200:1:202,206,208,209,202.1 S SRA(I)=$G(^SRF(SRTN,I)) 4 4 I $Y+14>IOSL D PAGE^SROAPCA I SRSOUT Q … … 46 46 S Y=$P($G(^SRF(SRTN,1.1)),"^",3),SRX=1.13,SRAO(2)=$$OUT(SRX,Y)_"^"_SRX 47 47 S Y=$P(SRA(208),"^",12),SRX=414,SRAO(3)=$$OUT(SRX,Y)_"^"_SRX 48 S Y=$P(SRA(206),"^",32),SRX=364.1 D DT S SRAO("1A")=X_"^"_SRX49 S Y=$P(SRA(208),"^",13),SRX=414.1 D DT S SRAO("3A")=X_"^"_SRX50 S Y=$P($G(^SRF(SRTN,.2)),"^",2),SRX=.22 D DT S SRAO(0)=X_"^"_SRX51 W !!,"V. OPERATIVE RISK SUMMARY DATA" S X=$P(SRAO(0),"^") W ?40,"(Operation Began: "_X_")"52 W !,?5,"Physician's Preoperative" S Y=$P($G(^SRF(SRTN,.2)),"^",3) D DT W ?40,"(Operation Ended: "_X_")"48 S Y=$P(SRA(206),"^",32),SRX=364.1,SRAO("1A")=$$OUT(SRX,Y)_"^"_SRX 49 S Y=$P(SRA(208),"^",13),SRX=414.1,SRAO("3A")=$$OUT(SRX,Y)_"^"_SRX 50 S Y=$P($G(^SRF(SRTN,.2)),"^",2),SRX=.22,SRAO(0)=$$OUT(SRX,Y)_"^"_SRX 51 W !!,"V. OPERATIVE RISK SUMMARY DATA" S X=$P(SRAO(0),"^") I X'="" W ?40,"(Operation Began: "_X_")" 52 W !,?5,"Physician's Preoperative" S Y=$P($G(^SRF(SRTN,.2)),"^",3) I Y'="" D DT W ?40,"(Operation Ended: "_X_")" 53 53 W !,?7,"Estimate of Operative Mortality: "_$P(SRAO(1),"^") I $P(SRAO(1),"^")'=""&($P(SRAO(1),"^")'="NS") W "%" 54 54 S X=$P(SRAO("1A"),"^") I X'="" W ?57,"("_X_")" 55 W !,?5,"ASA Classification:",?35,$P(SRAO(2),"^") 56 S X=$P(SRAO(3),"^") W !,?5,"Surgical Priority:",?($S($L(X)>10:24,1:35)),X S X=$P(SRAO("3A"),"^") I X'="" W ?57,"("_X_")" 55 W !,?5,"ASA Classification:",?35,$P(SRAO(2),"^"),!,?5,"Surgical Priority:",?35,$P(SRAO(3),"^") S X=$P(SRAO("3A"),"^") I X'="" W ?57,"("_X_")" 57 56 S X=$P($G(^SRO(136,SRTN,0)),"^",2) I X S Y=$P($$CPT^ICPTCOD(X),"^",2) D SSPRIN^SROCPT0 S X=Y 58 57 S X=$S(X'="":X,1:"CPT Code Missing") -
FOIAVistA/tag/r/SURGERY-SR/SROAPCA3.m
r628 r636 1 SROAPCA3 ;B'HAM ISC/MAM - CARDIAC OCCURRENCE DATA ;0 2/05/082 ;;3.0; Surgery ;**38,71,95,101,125,160,164 ,166**;24 Jun 93;Build 61 SROAPCA3 ;B'HAM ISC/MAM - CARDIAC OCCURRENCE DATA ;08/23/07 2 ;;3.0; Surgery ;**38,71,95,101,125,160,164**;24 Jun 93;Build 2 3 3 D EN^SROCCAT K SRA S SRA(205)=$G(^SRF(SRTN,205)),SRA(208)=$G(^SRF(SRTN,208)),SRA(206)=$G(^SRF(SRTN,206)),SRA(209)=$G(^SRF(SRTN,209)) 4 4 S NYUK=$P(SRA(208),"^") D YN S SRAO(1)=SHEMP_"^384" … … 32 32 S SRA(.2)=$G(^SRF(SRTN,.2)) 33 33 W !!,"VIII. RESOURCE DATA" 34 S Y=$P( SRA(208),"^",14) D DT^SROAPCA1 W !,"Hospital Admission Date:",?47,X35 S Y=$P( SRA(208),"^",15) D DT^SROAPCA1 W !,"Hospital Discharge Date:",?47,X34 S Y=$P($G(^SRF(SRTN,208)),"^",14) D DT^SROAPCA1 W !,"Hospital Admission Date:",?47,X 35 S Y=$P($G(^SRF(SRTN,208)),"^",15) D DT^SROAPCA1 W !,"Hospital Discharge Date:",?47,X 36 36 S Y=$P(SRA(.2),"^",10) D DT^SROAPCA1 W !,"Time Patient In OR: ",?47,X 37 37 S Y=$P(SRA(.2),"^",12) D DT^SROAPCA1 W !,"Time Patient Out OR: ",?47,X 38 S Y=$P( SRA(208),"^",22) I Y>1 D DT^SROAPCA1 S Y=X38 S Y=$P($G(^SRF(SRTN,208)),"^",22) I Y>1 D DT^SROAPCA1 S Y=X 39 39 S Y=$S(Y="NS":"Unable to determine",Y="RI":"Remains intubated at 30 days",1:Y) W !,"Date and Time Patient Extubated: ",?47,Y 40 I $P(SRA(208),"^",22)>1,$P(SRA(.2),"^",12) D 41 .S X=$$FMDIFF^XLFDT($P(SRA(208),"^",22),$P(SRA(.2),"^",12),2) W !,?5,"Postop Intubation Hrs: "_$FN((X/3600),"+",1) 42 S Y=$P(SRA(208),"^",23) I Y>1 D DT^SROAPCA1 S Y=X 40 S Y=$P($G(^SRF(SRTN,208)),"^",23) I Y>1 D DT^SROAPCA1 S Y=X 43 41 S Y=$S(Y="NS":"Unable to determine",Y="RI":"Remains in ICU at 30 days",1:Y) W !,"Date and Time Patient Discharged from ICU: ",?47,Y 44 42 S Y=$P(SRA(209),"^") W !,"Patient is Homeless: ",?47,$S(Y="Y":"YES",Y="N":"NO",Y="NS":"NS",1:"") 45 43 S Y=$P(SRA(206),"^",41) W !,"Cardiac Surg Performed at Non-VA Facility: ",?47,$S(Y="Y":"YES",Y="N":"NO",Y="NS":"UNKNOWN",1:"") 46 44 S Y=$P(SRA(209),"^",15) D DT^SROAPCA1 W !,"CT Surgery Consult Date: ",?47,$P(X," ") 47 S Y=$P(SRA(209),"^",16),C=$P(^DD(130,515,0),"^",2) D:Y'="" Y^DIQ W !,"Cause for Delay for Surgery: ",?47,Y48 45 W !,"Resource Data Comments: " 49 46 I $G(^SRF(SRTN,206.2))'="" S SRQ=0 S X=$G(^SRF(SRTN,206.2)) W:$L(X)<49 X,! I $L(X)>48 S Z=$L(X) D -
FOIAVistA/tag/r/SURGERY-SR/SROAPM.m
r628 r636 1 SROAPM ;BIR/ADM - PATIENT DEMOGRAPHIC INFO ;0 3/03/082 ;;3.0; Surgery ;**47,81,111,107,100,125,142,160 ,166**;24 Jun 93;Build 61 SROAPM ;BIR/ADM - PATIENT DEMOGRAPHIC INFO ;01/23/07 2 ;;3.0; Surgery ;**47,81,111,107,100,125,142,160**;24 Jun 93;Build 7 3 3 I '$D(SRTN) W !!,"A Surgery Risk Assessment must be selected prior to using this option.",!!,"Press <RET> to continue " R X:DTIME G END 4 4 S SRSOUT=0,SRSUPCPT=1 D ^SROAUTL … … 40 40 I '$G(VADM(12)) W ?40,"UNANSWERED" 41 41 ; 42 K DA,DIC,DIQ,DR,SRY S (DR,SRDR)="342;516;513",DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="E",DR=SRDR D EN^DIQ1 K DA,DIC,DIQ,DR 43 S SRZ=12 F M=1:1 S I=$P(SRDR,";",M) Q:'I D 44 .D TR,GET 45 .S SRZ=SRZ+1,Y=$P(X,";;",2),SRFLD=$P(Y,"^"),(Z,SRZ(SRZ))=$P(Y,"^",2)_"^"_SRFLD,SREXT=SRY(130,SRTN,SRFLD,"E") 46 .W !,$S($L(SRZ)<2:" "_SRZ,1:SRZ)_". "_$P(Z,"^")_":" D EXT 47 ;S SRZ=15,SRZ(13)="Date of Death^342",SREXT=SRY(130,SRTN,342,"E") W !,"13. Date/Time of Death:",?40,SREXT 48 ;S SRZ(14)="Surgery Consult Date^513",SREXT=SRY(130,SRTN,513,"E") W !,"14. Surgery Consult Date:",?40,SREXT 49 ;S SRZ(15)="Date Surgery Consult Requested^516",SREXT=SRY(130,SRTN,516,"E") W !,"15. Date Surgery Consult Requested:",?40,SREXT 42 K DA,DIC,DIQ,DR,SRY S (DR,SRDR)="342",DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="E",DR=SRDR D EN^DIQ1 K DA,DIC,DIQ,DR 43 S SRZ=13,SRZ(13)="Date of Death^342",SREXT=SRY(130,SRTN,342,"E") 44 W !,"13. Date/Time of Death:",?40,SREXT 50 45 K SROL,SROLINE,SRORC,SRORACE,SROLN,SROLN1,SROWRAP,SRNUM1 51 46 ; … … 81 76 .F I=0:1:38 S J=39-I,Y=$E(X,J) I Y=" " W ?40,$E(X,1,J-1) S X=$E(X,J+1,$L(X)) Q 82 77 Q 83 SEL W !!,"Select Patient Demographics Information to Edit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q78 SEL W !!,"Select number of item to edit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q 84 79 I (X=11)!(X=12) S SRR=1 W !!,"The Patient's Race and Ethnicity information cannot be updated through the" D Q 85 80 .W !,"Surgery package options." … … 98 93 Q 99 94 HELP W @IOF,!!!!,"Enter the number or range of numbers you want to edit. Examples of proper",!,"responses are listed below.",!!,"NOTE: Items 11 and 12 cannot be updated through the surgery package options." 100 W !!,"1. Enter 'A' to update items 1 through 10 and item s 13 through 15.",!!,"2. Enter a number (1-"_SRZ_") to update an individual item. (For example,",!," enter '1' to update "_$P(SRZ(1),"^")_")"95 W !!,"1. Enter 'A' to update items 1 through 10 and item 13.",!!,"2. Enter a number (1-"_SRZ_") to update an individual item. (For example,",!," enter '1' to update "_$P(SRZ(1),"^")_")" 101 96 W !!,"3. Enter a range of numbers (1-"_SRZ_") separated by a ':' to enter a range",!," of items. (For example, enter '1:4' to update items 1, 2, 3 and 4.)",! 102 97 I $D(SRFLG) W !,"4. Enter 'N' or 'NO' to enter negative response for all items.",!!,"5. Enter '@' to delete information from all items.",! … … 105 100 RANGE ; range of numbers 106 101 I $$LOCK^SROUTL(SRTN) D D UNLOCK^SROUTL(SRTN) 107 .S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) D 108 ..I SHEMP<13 F EMILY=SHEMP:1:10,13:1:15 Q:SRSOUT D ONE 109 ..I SHEMP>12 F EMILY=SHEMP:1:15 Q:SRSOUT D ONE 102 .S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) F EMILY=SHEMP:1:10,13 Q:SRSOUT D ONE 110 103 Q 111 104 ONE ; edit one item … … 130 123 DEC ;;453^Observation Discharge Date/Time 131 124 DED ;;454^Observation Treating Specialty 132 EAC ;;513^Surgery Consult Date133 EAF ;;516^Date Surgery Consult Requested -
FOIAVistA/tag/r/SURGERY-SR/SROAPRE.m
r628 r636 1 SROAPRE ;BIR/MAM - PREOPERATIVE INFO ; 11/26/072 ;;3.0; Surgery ;**38,47,55,88,100,125,142 ,166**;24 Jun 93;Build 61 SROAPRE ;BIR/MAM - PREOPERATIVE INFO ;06/03/05 2 ;;3.0; Surgery ;**38,47,55,88,100,125,142**;24 Jun 93 3 3 I '$D(SRTN) W !!,"A Surgery Risk Assessment must be selected prior to using this option.",!!,"Press <RET> to continue " R X:DTIME G END 4 4 S (SRSOUT,SRACLR)=0,SRSUPCPT=1 D ^SROAUTL,DUP^SROAUTL G:SRSOUT END … … 20 20 .I $$LOCK^SROUTL(SRTN) W ! D:EMILY<4 ^SROAPRE1 D:EMILY>3 ^SROAPR1A D UNLOCK^SROUTL(SRTN) 21 21 I $D(SRAO(X)),$$LOCK^SROUTL(SRTN) D D UNLOCK^SROUTL(SRTN) 22 .I X="1H" D FUNCTH Q 22 .I X="1J" D FUNCTI Q 23 .I X="1I" D FUNCTJ Q 23 24 .S SRX=X W ! K DR,DIE S DA=SRTN,DR=$P(SRAO(X),"^",2)_"T",DIE=130 D ^DIE K DR 24 25 G START 25 26 END I '$D(SREQST) W @IOF D ^SRSKILL 26 27 Q 27 FUNCT HN X K DA,DIR S DA=SRTN,DIR(0)="130,492",DIR("A")="Functional Health Status at Evaluation for Surgery" D ^DIR K DIR D Q28 FUNCTI N X K DA,DIR S DA=SRTN,DIR(0)="130,492",DIR("A")="Functional Health Status at Evaluation for Surgery" D ^DIR K DIR D Q 28 29 .I $D(DTOUT)!$D(DUOUT) Q 29 30 .I X="@" K DIE,DR S DIE=130,DR="492///@" D ^DIE K DA,DIE,DR Q 30 31 .K DIE,DR S DIE=130,DR="492////"_Y D ^DIE K DA,DIE,DR 32 Q 33 FUNCTJ N X K DA,DIR S DA=SRTN,DIR(0)="130,240",DIR("A")="Functional Health Status Prior to Current Illness" D ^DIR K DIR D Q 34 .I $D(DTOUT)!$D(DUOUT) Q 35 .I X="@" K DIE,DR S DIE=130,DR="240///@" D ^DIE K DA,DIE,DR Q 36 .K DIE,DR S DIE=130,DR="240////"_Y D ^DIE K DA,DIE,DR 31 37 Q 32 38 HELP W @IOF,!!!!,"Enter the number, number/letter combination, or range of numbers you want to",!,"edit. Examples of proper responses are listed below." -
FOIAVistA/tag/r/SURGERY-SR/SROAPRE1.m
r628 r636 1 SROAPRE1 ;B IR/MAM - EDIT PAGE 1 PREOP ;11/26/072 ;;3.0; Surgery ;**38,47,125,135,141 ,166**;24 Jun 93;Build 61 SROAPRE1 ;B'HAM ISC/MAM - EDIT PAGE 1 PREOP ;01/05/05 2 ;;3.0; Surgery ;**38,47,125,135,141**;24 Jun 93 3 3 K DA D @EMILY Q 4 4 1 ; edit general information … … 25 25 GEN ; general 26 26 N SRUP S SRUP="" 27 W ! K DR,DIE S DA=SRTN,DIE=130,DR="236T;237T;346T;202T;246T;325T;238T" D ^DIE K DIE,DR I $D(Y) Q 28 K DIR S DA=SRTN,DIR(0)="130,492",DIR("A")="Functional Health Status at Evaluation for Surgery" D ^DIR K DIR D 27 W ! K DR,DIE S DA=SRTN,DIE=130,DR="236T;237T;346T;202T;202.1T;246T;325T;238T" D ^DIE K DIE,DR I $D(Y) Q 28 K DIR S DA=SRTN,DIR(0)="130,240",DIR("A")="Functional Health Status Prior to Current Illness" D ^DIR K DIR D Q:SRUP 29 .I $D(DTOUT) Q 30 .I $D(DUOUT) S SRUP=1 Q 31 .I X="@" K DIE,DR S DIE=130,DR="240///@" D ^DIE K DA,DIE,DR Q 32 .K DIE,DR S DIE=130,DR="240////"_Y D ^DIE K DA,DIE,DR 33 S DA=SRTN,DIR(0)="130,492",DIR("A")="Functional Health Status at Evaluation for Surgery" D ^DIR K DIR D 29 34 .I $D(DTOUT)!$D(DUOUT) Q 30 35 .I X="@" K DIE,DR S DIE=130,DR="492///@" D ^DIE K DA,DIE,DR Q … … 34 39 NOGEN ; no general problems 35 40 S $P(^SRF(SRTN,200),"^",6)=$S(X="":"",1:1) F I=2,3,4,7 S $P(^SRF(SRTN,200),"^",I)=SRAX 36 S $P(^SRF(SRTN,200 .1),"^",2)=$S(X="":"",X="NS":"NS",1:1)41 S $P(^SRF(SRTN,200),"^",8)=$S(X="":"",X="NS":"NS",1:1),$P(^SRF(SRTN,208),"^",9)=$S(X="":"",X="NS":"NS",1:0),$P(^SRF(SRTN,200.1),"^",2)=$S(X="":"",X="NS":"NS",1:1) 37 42 Q 38 43 PULM ; pulmonary -
FOIAVistA/tag/r/SURGERY-SR/SROAPRE2.m
r628 r636 1 SROAPRE2 ;BIR/MAM - EDIT PAGE 2 PREOP ; 11/26/072 ;;3.0; Surgery ;**38,47,125,153 ,166**;24 Jun 93;Build 61 SROAPRE2 ;BIR/MAM - EDIT PAGE 2 PREOP ;06/27/06 2 ;;3.0; Surgery ;**38,47,125,153**;24 Jun 93;Build 11 3 3 D @EMILY Q 4 4 1 ; edit renal information … … 31 31 Q 32 32 CNS ; cns 33 W ! K DR,DIE S DIE=130,DA=SRTN,DR="332T;333T;400T;334T;335T;336T;401T; " D ^DIE K DR,DIE33 W ! K DR,DIE S DIE=130,DA=SRTN,DR="332T;333T;400T;334T;335T;336T;401T;399T;398T;" D ^DIE K DR,DIE 34 34 S SRACLR=0 35 35 Q 36 36 NOCNS ; no CNS problems 37 F I=19,21 ,24:1:27,29 S $P(^SRF(SRTN,200),"^",I)=SRAX37 F I=19,21:1:27,29 S $P(^SRF(SRTN,200),"^",I)=SRAX 38 38 Q 39 39 NUT ; nutritional/immune/other -
FOIAVistA/tag/r/SURGERY-SR/SROAPRT1.m
r628 r636 1 SROAPRT1 ;BIR/MAM - PREOP INFO (PAGE 1) ; 11/28/072 ;;3.0; Surgery ;**38,47,125,153 ,166**;24 Jun 93;Build 61 SROAPRT1 ;BIR/MAM - PREOP INFO (PAGE 1) ;02/23/06 2 ;;3.0; Surgery ;**38,47,125,153**;24 Jun 93;Build 11 3 3 N SRX,Y F I=200,206 S SRA(I)=$G(^SRF(SRTN,I)) 4 4 S Y=$P(SRA(200),"^"),SRX=402,SRAO(1)=$$OUT(SRX,Y)_"^"_SRX … … 7 7 S Y=$P(SRA(200),"^",2),SRX=346,SRAO("1C")=$$OUT(SRX,Y)_"^"_SRX 8 8 S Y=$P(SRA(200),"^",3),SRX=202,SRAO("1D")=$$OUT(SRX,Y)_"^"_SRX 9 S Y=$P(SRA(200),"^",4),SRX=246,SRAO("1E")=$$OUT(SRX,Y)_"^"_SRX 10 S Y=$P(SRA(200),"^",6),SRX=325,SRAO("1F")=$$OUT(SRX,Y)_"^"_SRX 11 S Y=$P(SRA(200),"^",7),SRX=238,SRAO("1G")=$$OUT(SRX,Y)_"^"_SRX 12 S Y=$P($G(^SRF(SRTN,200.1)),"^",2),SRX=492,SRAO("1H")=$$OUT(SRX,Y)_"^"_SRX 9 S Y=$P($G(^SRF(SRTN,208)),"^",9),SRX=202.1,SRAO("1E")=$$OUT(SRX,Y)_"^"_SRX 10 S Y=$P(SRA(200),"^",4),SRX=246,SRAO("1F")=$$OUT(SRX,Y)_"^"_SRX 11 S Y=$P(SRA(200),"^",6),SRX=325,SRAO("1G")=$$OUT(SRX,Y)_"^"_SRX 12 S Y=$P(SRA(200),"^",7),SRX=238,SRAO("1H")=$$OUT(SRX,Y)_"^"_SRX 13 S Y=$P(SRA(200),"^",8),SRX=240,SRAO("1I")=$$OUT(SRX,Y)_"^"_SRX 14 S Y=$P($G(^SRF(SRTN,200.1)),"^",2),SRX=492,SRAO("1J")=$$OUT(SRX,Y)_"^"_SRX 13 15 S Y=$P(SRA(200),"^",9),SRX=241,SRAO(2)=$$OUT(SRX,Y)_"^"_SRX 14 16 S Y=$P(SRA(200),"^",10),SRX=204,SRAO("2A")=$$OUT(SRX,Y)_"^"_SRX … … 30 32 S Y=$P(SRA(200),"^",42),SRX=330,SRAO("6B")=$$OUT(SRX,Y)_"^"_SRX 31 33 W:$E(IOST)="P" ! W !,?28,"PREOPERATIVE INFORMATION",!! 32 W "GENERAL:",?31,$P(SRAO(1),"^"),?40," GASTROINTESTINAL:",?72,$P(SRAO(4),"^")33 W !,"Height: ",?22,$J($P(SRAO("1A"),"^"),15),?40," Esophageal Varices:",?72,$P(SRAO("4A"),"^")34 W "GENERAL:",?31,$P(SRAO(1),"^"),?40,"HEPATOBILIARY:",?72,$P(SRAO(3),"^") 35 W !,"Height: ",?22,$J($P(SRAO("1A"),"^"),15),?40,"Ascites:",?72,$P(SRAO("3A"),"^") 34 36 W !,"Weight:",?22,$J($P(SRAO("1B"),"^"),15) 35 W !,"Diabetes Mellitus:",?31,$P(SRAO("1C"),"^"),?40,"CARDIAC:",?72,$P(SRAO(5),"^") 36 W !,"Current Smoker W/I 1 Year:",?31,$P(SRAO("1D"),"^"),?40,"CHF Within 1 Month:",?72,$P(SRAO("5A"),"^") 37 W !,"ETOH > 2 Drinks/Day:",?31,$P(SRAO("1E"),"^"),?40,"MI Within 6 Months:",?72,$P(SRAO("5B"),"^") 38 W !,"Dyspnea: ",?13,$J($P(SRAO("1F"),"^"),25),?40,"Previous PCI:",?72,$P(SRAO("5C"),"^") 39 W !,"DNR Status: ",?31,$P(SRAO("1G"),"^"),?40,"Previous Cardiac Surgery:",?72,$P(SRAO("5D"),"^") 40 W !,"Preop Funct Status: ",$J($P(SRAO("1H"),"^"),17),?40,"Angina Within 1 Month:",?72,$P(SRAO("5E"),"^") 37 W !,"Diabetes Mellitus:",?31,$P(SRAO("1C"),"^"),?40,"GASTROINTESTINAL:",?72,$P(SRAO(4),"^") 38 W !,"Current Smoker W/I 1 Year:",?31,$P(SRAO("1D"),"^"),?40,"Esophageal Varices:",?72,$P(SRAO("4A"),"^") 39 W !,"Pack/Years:",?31,$P(SRAO("1E"),"^") 40 W !,"ETOH > 2 Drinks/Day:",?31,$P(SRAO("1F"),"^"),?40,"CARDIAC:",?72,$P(SRAO(5),"^") 41 W !,"Dyspnea: ",?13,$J($P(SRAO("1G"),"^"),25),?40,"CHF Within 1 Month:",?72,$P(SRAO("5A"),"^") 42 W !,"DNR Status: ",?31,$P(SRAO("1H"),"^"),?40,"MI Within 6 Months:",?72,$P(SRAO("5B"),"^") 43 W !,"Pre-illness Funct",?40,"Previous PCI:",?72,$P(SRAO("5C"),"^") 44 W !,?12,"Status: ",$J($P(SRAO("1I"),"^"),17),?40,"Previous Cardiac Surgery:",?72,$P(SRAO("5D"),"^") 45 W !,"Preop Funct Status: ",$J($P(SRAO("1J"),"^"),17),?40,"Angina Within 1 Month:",?72,$P(SRAO("5E"),"^") 41 46 W !,?40,"Hypertension Requiring Meds:",?72,$P(SRAO("5F"),"^") 42 47 W !,"PULMONARY:",?31,$P(SRAO(2),"^") … … 44 49 W !,"History of Severe COPD:",?31,$P(SRAO("2B"),"^"),?40,"Revascularization/Amputation:",?72,$P(SRAO("6A"),"^") 45 50 W !,"Current Pneumonia:",?31,$P(SRAO("2C"),"^"),?40,"Rest Pain/Gangrene:",?72,$P(SRAO("6B"),"^") 46 W !!,"HEPATOBILIARY:",?31,$P(SRAO(3),"^"),!,"Ascites:",?31,$P(SRAO("3A"),"^")47 51 Q 48 52 OUT(SRFLD,SRY) ; get data in output form -
FOIAVistA/tag/r/SURGERY-SR/SROAPRT2.m
r628 r636 1 SROAPRT2 ;BIR/MAM - PRINT PREOP INFO (PAGE 2) ; 11/28/072 ;;3.0; Surgery ;**38,125,137,153,160 ,166**;24 Jun 93;Build 61 SROAPRT2 ;BIR/MAM - PRINT PREOP INFO (PAGE 2) ;04/24/07 2 ;;3.0; Surgery ;**38,125,137,153,160**;24 Jun 93;Build 7 3 3 I $E(IOST)'="P" W !,?28,"PREOPERATIVE INFORMATION" 4 4 N SRX,Y S SRA(200)=$G(^SRF(SRTN,200)),SRA(206)=$G(^SRF(SRTN,206)) … … 10 10 S Y=$P(SRA(200),"^",19),SRX=332,SRAO("2A")=$$OUT(SRX,Y)_"^"_SRX 11 11 S Y=$P(SRA(200),"^",21),SRX=333,SRAO("2B")=$$OUT(SRX,Y)_"^"_SRX 12 S Y=$P(SRA(200),"^",22),SRX=398,SRAO("2I")=$$OUT(SRX,Y)_"^"_SRX 13 S Y=$P(SRA(200),"^",23),SRX=399,SRAO("2H")=$$OUT(SRX,Y)_"^"_SRX 12 14 S Y=$P(SRA(200),"^",24),SRX=400,SRAO("2C")=$$OUT(SRX,Y)_"^"_SRX 13 15 S Y=$P(SRA(200),"^",25),SRX=334,SRAO("2D")=$$OUT(SRX,Y)_"^"_SRX … … 37 39 W !,"CVA/Stroke w/o Neuro Deficit:",?31,$P(SRAO("2F"),"^"),?40,"Pregnancy:",?(74-$L($P(SRAO("3J"),"^"))),$P(SRAO("3J"),"^") 38 40 W !,"Tumor Involving CNS:",?31,$P(SRAO("2G"),"^") 41 W !,"Paraplegia:",?31,$P(SRAO("2H"),"^") 42 W !,"Quadriplegia:",?31,$P(SRAO("2I"),"^") 39 43 I $E(IOST)="P" W ! 40 44 Q -
FOIAVistA/tag/r/SURGERY-SR/SROAPRT4.m
r628 r636 1 SROAPRT4 ;BIR/MAM - PRINT ASSESSMENT (CONT.) ;0 1/14/082 ;;3.0; Surgery ;**38,125,153,160 ,166**;24 Jun 93;Build 61 SROAPRT4 ;BIR/MAM - PRINT ASSESSMENT (CONT.) ;06/28/06 2 ;;3.0; Surgery ;**38,125,153,160**;24 Jun 93;Build 7 3 3 ;K SRA S SRA(201)=$G(^SRF(SRTN,201)),SRA(202)=$G(^SRF(SRTN,202)) 4 4 K SRA F I=201,202,203,204,202.1 S SRA(I)=$G(^SRF(SRTN,I)) … … 7 7 W !,$J("Serum Sodium: ",39) S X=$P(SRA(201),"^") W X S X=$P(SRA(202),"^") I X D DATE W ?48,"("_Y_")" 8 8 W !,$J("Serum Creatinine: ",39) S X=$P(SRA(201),"^",4) W X S X=$P(SRA(202),"^",4) I X D DATE W ?48,"("_Y_")" 9 W !,$J("BUN: ",39) S X=$P(SRA(201),"^",5) W X S X=$P(SRA(202),"^",5) I X D DATE W ?48,"("_Y_")"10 W !,$J("Serum Albumin: ",39) S X=$P(SRA(201),"^",8) W X S X=$P(SRA(202),"^",8) I X D DATE W ?48,"("_Y_")"9 W !,$J("BUN: ",39) S X=$P(SRA(201),"^",5) W X I X S X=$P(SRA(202),"^",5) I X D DATE W ?48,"("_Y_")" 10 W !,$J("Serum Albumin: ",39) S X=$P(SRA(201),"^",8) W X I X S X=$P(SRA(202),"^",8) I X D DATE W ?48,"("_Y_")" 11 11 W !,$J("Total Bilirubin: ",39) S X=$P(SRA(201),"^",9) W X S X=$P(SRA(202),"^",9) I X D DATE W ?48,"("_Y_")" 12 W !,$J("SGOT: ",39) S X=$P(SRA(201),"^",11) W X S X=$P(SRA(202),"^",11) I X D DATE W ?48,"("_Y_")"13 W !,$J("Alkaline Phosphatase: ",39) S X=$P(SRA(201),"^",12) W X S X=$P(SRA(202),"^",12) I X D DATE W ?48,"("_Y_")"12 W !,$J("SGOT: ",39) S X=$P(SRA(201),"^",11) W X I X S X=$P(SRA(202),"^",11) I X D DATE W ?48,"("_Y_")" 13 W !,$J("Alkaline Phosphatase: ",39) S X=$P(SRA(201),"^",12) W X I X S X=$P(SRA(202),"^",12) I X D DATE W ?48,"("_Y_")" 14 14 W !,$J("White Blood Count: ",39) S X=$P(SRA(201),"^",13) W X S X=$P(SRA(202),"^",13) I X D DATE W ?48,"("_Y_")" 15 W !,$J("Hematocrit: ",39) S X=$P(SRA(201),"^",14) W X S X=$P(SRA(202),"^",14) I X D DATE W ?48,"("_Y_")"15 W !,$J("Hematocrit: ",39) S X=$P(SRA(201),"^",14) W X I X S X=$P(SRA(202),"^",14) I X D DATE W ?48,"("_Y_")" 16 16 W !,$J("Platelet Count: ",39) S X=$P(SRA(201),"^",15) W X S X=$P(SRA(202),"^",15) I X D DATE W ?48,"("_Y_")" 17 17 W !,$J("PTT: ",39) S X=$P(SRA(201),"^",16) W X S X=$P(SRA(202),"^",16) I X D DATE W ?48,"("_Y_")" 18 W !,$J("PT: ",39) S X=$P(SRA(201),"^",17) W X S X=$P(SRA(202),"^",17) I X D DATE W ?48,"("_Y_")"19 W !,$J("INR: ",39) S X=$P(SRA(201),"^",27) W X S X=$P(SRA(202),"^",27) I X D DATE W ?48,"("_Y_")"20 W !,$J("Hemoglobin A1c: ",39) S X=$P(SRA(201),"^",28) W X S X=$P(SRA(202.1),"^") I XD DATE W ?48,"("_Y_")"18 W !,$J("PT: ",39) S X=$P(SRA(201),"^",17) W X I X S X=$P(SRA(202),"^",17) I X D DATE W ?48,"("_Y_")" 19 W !,$J("INR: ",39) S X=$P(SRA(201),"^",27) W X I X S X=$P(SRA(202),"^",27) I X D DATE W ?48,"("_Y_")" 20 W !,$J("Hemoglobin A1c: ",39) S X=$P(SRA(201),"^",28) W X I X S X=$P(SRA(202.1),"^") D DATE W ?48,"("_Y_")" 21 21 I $E(IOST)="P" W !! 22 22 Q -
FOIAVistA/tag/r/SURGERY-SR/SROAPRT5.m
r628 r636 1 SROAPRT5 ;BIR/MAM - PRINT ASSESSMENT (CONT) ;0 1/14/082 ;;3.0; Surgery ;**38,88,153 ,166**;24 Jun 93;Build 61 SROAPRT5 ;BIR/MAM - PRINT ASSESSMENT (CONT) ;06/28/06 2 ;;3.0; Surgery ;**38,88,153**;24 Jun 93;Build 11 3 3 K SRA S SRA(203)=$G(^SRF(SRTN,203)),SRA(204)=$G(^SRF(SRTN,204)) 4 4 W:$E(IOST)="P" ! W !,?22,"POSTOPERATIVE LABORATORY RESULTS",!!,?29," * Highest Value",!,?29,"** Lowest Value" … … 9 9 W !,$J("** Potassium: ",39) S X=$P(SRA(203),"^",4) W X S X=$P(SRA(204),"^",4) I X D DATE W ?48,"("_Y_")" 10 10 W !,$J("* Serum Creatinine: ",39) S X=$P(SRA(203),"^",6) W X S X=$P(SRA(204),"^",6) I X D DATE W ?48,"("_Y_")" 11 W !,$J("* CPK: ",39) S X=$P(SRA(203),"^",7) W X S X=$P(SRA(204),"^",7) I X D DATE W ?48,"("_Y_")"11 W !,$J("* CPK: ",39) S X=$P(SRA(203),"^",7) W X I X S X=$P(SRA(204),"^",7) I X D DATE W ?48,"("_Y_")" 12 12 W !,$J("* CPK-MB Band: ",39) S X=$P(SRA(203),"^",8) W X S X=$P(SRA(204),"^",8) I X D DATE W ?48,"("_Y_")" 13 W !,$J("* Total Bilirubin: ",39) S X=$P(SRA(203),"^",9) W X S X=$P(SRA(204),"^",9) I X D DATE W ?48,"("_Y_")"13 W !,$J("* Total Bilirubin: ",39) S X=$P(SRA(203),"^",9) W X I X S X=$P(SRA(204),"^",9) I X D DATE W ?48,"("_Y_")" 14 14 W !,$J("* White Blood Count: ",39) S X=$P(SRA(203),"^",10) W X S X=$P(SRA(204),"^",10) I X D DATE W ?48,"("_Y_")" 15 15 W !,$J("** Hematocrit: ",39) S X=$P(SRA(203),"^",12) W X S X=$P(SRA(204),"^",12) I X D DATE W ?48,"("_Y_")" -
FOIAVistA/tag/r/SURGERY-SR/SROAPS1.m
r628 r636 1 SROAPS1 ;BIR/MAM - PREOP INFO (PAGE 1) ;12/12/07 2 ;;3.0; Surgery ;**38,47,125,153,166**;24 Jun 93;Build 6 3 ; 4 ; Reference to EN1^GMRVUT0 supported by DBIA #1446 5 ; 1 SROAPS1 ;BIR/MAM - PREOP INFO (PAGE 1) ;06/08/06 2 ;;3.0; Surgery ;**38,47,125,153**;24 Jun 93;Build 11 6 3 N I S SRPAGE="PAGE: 1 OF 2" D HDR^SROAUTL,PRE1 7 4 W ! F I=1:1:80 W "-" … … 13 10 S Y=$P(SRA(200),"^",2),SRX=346,SRAO("1C")=$$OUT(SRX,Y)_"^"_SRX 14 11 S Y=$P(SRA(200),"^",3),SRX=202,SRAO("1D")=$$OUT(SRX,Y)_"^"_SRX 15 S Y=$P(SRA(200),"^",4),SRX=246,SRAO("1E")=$$OUT(SRX,Y)_"^"_SRX 16 S Y=$P(SRA(200),"^",6),SRX=325,SRAO("1F")=$$OUT(SRX,Y)_"^"_SRX 17 S Y=$P(SRA(200),"^",7),SRX=238,SRAO("1G")=$$OUT(SRX,Y)_"^"_SRX 18 S Y=$P($G(^SRF(SRTN,200.1)),"^",2),SRX=492,SRAO("1H")=$$OUT(SRX,Y)_"^"_SRX 12 S Y=$P($G(^SRF(SRTN,208)),"^",9),SRX=202.1,SRAO("1E")=$$OUT(SRX,Y)_"^"_SRX 13 S Y=$P(SRA(200),"^",4),SRX=246,SRAO("1F")=$$OUT(SRX,Y)_"^"_SRX 14 S Y=$P(SRA(200),"^",6),SRX=325,SRAO("1G")=$$OUT(SRX,Y)_"^"_SRX 15 S Y=$P(SRA(200),"^",7),SRX=238,SRAO("1H")=$$OUT(SRX,Y)_"^"_SRX 16 S Y=$P(SRA(200),"^",8),SRX=240,SRAO("1I")=$$OUT(SRX,Y)_"^"_SRX 17 S Y=$P($G(^SRF(SRTN,200.1)),"^",2),SRX=492,SRAO("1J")=$$OUT(SRX,Y)_"^"_SRX 19 18 S Y=$P(SRA(200),"^",9),SRX=241,SRAO(2)=$$OUT(SRX,Y)_"^"_SRX 20 19 S Y=$P(SRA(200),"^",10),SRX=204,SRAO("2A")=$$OUT(SRX,Y)_"^"_SRX … … 35 34 S Y=$P(SRA(200),"^",41),SRX=329,SRAO("6A")=$$OUT(SRX,Y)_"^"_SRX 36 35 S Y=$P(SRA(200),"^",42),SRX=330,SRAO("6B")=$$OUT(SRX,Y)_"^"_SRX K SRA 37 W "1. GENERAL:",?32,$P(SRAO(1),"^"),?41,"4. GASTROINTESTINAL:",?76,$P(SRAO(4),"^") 38 W !," A. Height:" S Y=$P(SRAO("1A"),"^") W:Y'="NS" ?14,$J($P(Y,"^"),25) W:Y="NS" ?32,Y 39 W ?43,"A. Esophageal Varices:",?76,$P(SRAO("4A"),"^") 36 W "1. GENERAL:",?32,$P(SRAO(1),"^"),?41,"3. HEPATOBILIARY:",?76,$P(SRAO(3),"^") 37 W !," A. Height:" S Y=$P(SRAO("1A"),"^") W ?($S(Y="NS":19,1:24)),$J($P(Y,"^"),15),?43,"A. Ascites:",?76,$P(SRAO("3A"),"^") 40 38 W !," B. Weight:" S Y=$P(SRAO("1B"),"^") W ?($S(Y="NS":19,1:24)),$J(Y,15) 41 W !," C. Diabetes Mellitus:",?32,$P(SRAO("1C"),"^"),?41,"5. CARDIAC:",?76,$P(SRAO(5),"^") 42 W !," D. Current Smoker W/I 1 Year:",?32,$P(SRAO("1D"),"^"),?43,"A. CHF Within 1 Month:",?76,$P(SRAO("5A"),"^") 43 W !," E. ETOH > 2 Drinks/Day:",?32,$P(SRAO("1E"),"^"),?43,"B. MI Within 6 Months:",?76,$P(SRAO("5B"),"^") 44 W !," F. Dyspnea: ",?14,$J($P(SRAO("1F"),"^"),25),?43,"C. Previous PCI:",?76,$P(SRAO("5C"),"^") 45 W !," G. DNR Status: ",?32,$P(SRAO("1G"),"^"),?43,"D. Previous Cardiac Surgery:",?76,$P(SRAO("5D"),"^") 46 W !," H. Preop Funct Status: ",$J($P(SRAO("1H"),"^"),17),?43,"E. Angina Within 1 Month:",?76,$P(SRAO("5E"),"^") 39 W !," C. Diabetes Mellitus:",?32,$P(SRAO("1C"),"^"),?41,"4. GASTROINTESTINAL:",?76,$P(SRAO(4),"^") 40 W !," D. Current Smoker W/I 1 Year:",?32,$P(SRAO("1D"),"^"),?43,"A. Esophageal Varices:",?76,$P(SRAO("4A"),"^") 41 W !," E. Pack/Years:",?32,$P(SRAO("1E"),"^") 42 W !," F. ETOH > 2 Drinks/Day:",?32,$P(SRAO("1F"),"^"),?41,"5. CARDIAC:",?76,$P(SRAO(5),"^") 43 W !," G. Dyspnea: ",?14,$J($P(SRAO("1G"),"^"),25),?43,"A. CHF Within 1 Month:",?76,$P(SRAO("5A"),"^") 44 W !," H. DNR Status: ",?32,$P(SRAO("1H"),"^"),?43,"B. MI Within 6 Months:",?76,$P(SRAO("5B"),"^") 45 W !," I. Pre-illness Funct",?43,"C. Previous PCI:",?76,$P(SRAO("5C"),"^") 46 W !,?17,"Status: ",$J($P(SRAO("1I"),"^"),17),?43,"D. Previous Cardiac Surgery:",?76,$P(SRAO("5D"),"^") 47 W !," J. Preop Funct Status: ",$J($P(SRAO("1J"),"^"),17),?43,"E. Angina Within 1 Month:",?76,$P(SRAO("5E"),"^") 47 48 W !,?43,"F. Hypertension Requiring Meds:",?76,$P(SRAO("5F"),"^") 48 49 W !,"2. PULMONARY:",?32,$P(SRAO(2),"^") … … 50 51 W !," B. History of Severe COPD:",?32,$P(SRAO("2B"),"^"),?43,"A. Revascularization/Amputation:",?76,$P(SRAO("6A"),"^") 51 52 W !," C. Current Pneumonia:",?32,$P(SRAO("2C"),"^"),?43,"B. Rest Pain/Gangrene:",?76,$P(SRAO("6B"),"^") 52 W !!,"3. HEPATOBILIARY:",?32,$P(SRAO(3),"^"),!," A. Ascites:",?32,$P(SRAO("3A"),"^")53 53 Q 54 54 OUT(SRFLD,SRY) ; get data in output form 55 N C,Y ,Z55 N C,Y 56 56 S Y=SRY,C=$P(^DD(130,SRFLD,0),"^",2) D:Y'="" Y^DIQ 57 57 I Y="NO STUDY" S Y="NS" 58 I SRFLD=237!(SRFLD=346) S Y=$E(Y,1,15) 59 I SRFLD=236 S Z=$P($G(^SRF(SRTN,200.1)),"^",7) I Z'="" S Y="("_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_$E(Z,2,3)_") "_Y 60 I SRFLD=492 D 58 I SRFLD=236!(SRFLD=237)!(SRFLD=346) S Y=$E(Y,1,15) 59 I SRFLD=240!(SRFLD=492) D 61 60 .I SRY=2 S Y="PARTIAL DEPENDENT" Q 62 61 .I SRY=1 S Y=Y_" " Q … … 65 64 Q Y 66 65 HW ; get weight & height from Vitals 67 N SREND,SRE Q,SREX,SREY,SRSTRT66 N SREND,SREX,SRSTRT 68 67 WT I $P($G(^SRF(SRTN,206)),"^",2)="" D 69 68 .S SREND=$P($G(^SRF(SRTN,0)),"^",9),SRSTRT=$$FMADD^XLFDT(SREND,-30),SREX=$$HW^SROACL1(SRSTRT,SREND,"WT") 70 .I SREX'="" S SREX=SREX+.5\1 D CHK^DIE(130,237,"E",SREX,.SREY) I SREY'="^" S $P(^SRF(SRTN,206),"^",2)=SREY 71 HT I $P($G(^SRF(SRTN,206)),"^")'="" Q 72 N GMRVSTR,SRBRDT,SRBIEN,SRBDATA,SRHTDT 73 K ^UTILITY($J,"GMRVD"),RESULTS S SREND=$P($G(^SRF(SRTN,0)),"^",9),GMRVSTR="HT",GMRVSTR(0)="^"_SREND_"^^0" 74 D EN1^GMRVUT0 Q:'$D(^UTILITY($J,"GMRVD")) 75 S SRBRDT="",SRBRDT=$O(^UTILITY($J,"GMRVD","HT",SRBRDT)) Q:'SRBRDT D 76 .S SRBIEN=0 F S SRBIEN=$O(^UTILITY($J,"GMRVD","HT",SRBRDT,SRBIEN)) Q:'SRBIEN D 77 ..S SRBDATA=$G(^UTILITY($J,"GMRVD","HT",SRBRDT,SRBIEN)),SREX=$P(SRBDATA,"^",8) 78 ..I SREX'="" S SREX=SREX+.5\1 D CHK^DIE(130,236,"E",SREX,.SREY) I SREY'="^" D 79 ...S $P(^SRF(SRTN,206),"^")=SREY 80 ...S SRHTDT=$P(SRBDATA,"^") I SRHTDT'="" S $P(^SRF(SRTN,200.1),"^",7)=SRHTDT 69 .I SREX'="" S SREX=SREX+.5\1,$P(^SRF(SRTN,206),"^",2)=SREX 70 HT I $P($G(^SRF(SRTN,206)),"^")="" D 71 .S SREND=$P($G(^SRF(SRTN,0)),"^",9),SRSTRT=$$FMADD^XLFDT(SREND,-365),SREX=$$HW^SROACL1(SRSTRT,SREND,"HT") 72 .I SREX'="" S SREX=SREX+.5\1,$P(^SRF(SRTN,206),"^")=SREX 81 73 Q -
FOIAVistA/tag/r/SURGERY-SR/SROAPS2.m
r628 r636 1 SROAPS2 ;BIR/MAM - PREOP INFO (PAGE 2) ; 11/26/072 ;;3.0; Surgery ;**38,47,125,153,160 ,166**;24 Jun 93;Build 61 SROAPS2 ;BIR/MAM - PREOP INFO (PAGE 2) ;04/24/07 2 ;;3.0; Surgery ;**38,47,125,153,160**;24 Jun 93;Build 7 3 3 S SRPAGE="PAGE: 2 OF 2" D HDR^SROAUTL,PRE2 4 4 W !! F I=1:1:80 W "-" … … 13 13 S Y=$P(SRA(200),"^",19),SRX=332,SRAO("2A")=$$OUT(SRX,Y)_"^"_SRX 14 14 S Y=$P(SRA(200),"^",21),SRX=333,SRAO("2B")=$$OUT(SRX,Y)_"^"_SRX 15 S Y=$P(SRA(200),"^",22),SRX=398,SRAO("2I")=$$OUT(SRX,Y)_"^"_SRX 16 S Y=$P(SRA(200),"^",23),SRX=399,SRAO("2H")=$$OUT(SRX,Y)_"^"_SRX 15 17 S Y=$P(SRA(200),"^",24),SRX=400,SRAO("2C")=$$OUT(SRX,Y)_"^"_SRX 16 18 S Y=$P(SRA(200),"^",25),SRX=334,SRAO("2D")=$$OUT(SRX,Y)_"^"_SRX … … 40 42 W !," F. CVA/Stroke w/o Neuro Deficit:",?(38-$L($P(SRAO("2F"),"^"))),$P(SRAO("2F"),"^"),?40," J. Pregnancy:",?(79-$L($P(SRAO("3J"),"^"))),$P(SRAO("3J"),"^") 41 43 W !," G. Tumor Involving CNS:",?(38-$L($P(SRAO("2G"),"^"))),$P(SRAO("2G"),"^") 44 W !," H. Paraplegia:",?(38-$L($P(SRAO("2H"),"^"))),$P(SRAO("2H"),"^") 45 W !," I. Quadriplegia:",?(38-$L($P(SRAO("2I"),"^"))),$P(SRAO("2I"),"^") 42 46 Q 43 47 OUT(SRFLD,SRY) ; get data in output form -
FOIAVistA/tag/r/SURGERY-SR/SROASS.m
r628 r636 1 1 SROASS ;BIR/MAM - SELECT ASSESSMENT ;01/18/07 2 ;;3.0; Surgery ;**38,47,64,94,121,100,160 ,166**;24 Jun 93;Build 62 ;;3.0; Surgery ;**38,47,64,94,121,100,160**;24 Jun 93;Build 7 3 3 PST K:$D(DUZ("SAV")) SRNEW K SRTN W !! S SRSOUT=0 4 4 N SRSEL D ^SROPSEL G:'$D(DFN) END S SRANM=VADM(1)_" "_VA("PID") … … 26 26 S:X="" X=1 I X<1!(X>3)!(X'?.N) D HELP G ENTER 27 27 I X=2 D ^SROADEL W !!,"Press <RET> to continue " R X:DTIME W @IOF K SRTN G END 28 I X=3 D @($S($P(SR("RA"),"^",2)="C":"^SROACOM1",1:"^SROACOM"))K SRTN G END28 I X=3 D ^SROACOM K SRTN G END 29 29 Q 30 30 EXCL I $P($G(^SRO(136,SRTN,10)),"^"),'$$XL^SROAX(SRTN) D -
FOIAVistA/tag/r/SURGERY-SR/SROASSP.m
r628 r636 1 SROASSP ;B IR/MAM - PRINT A COMPLETED ASSESSMENT ;12/05/072 ;;3.0; Surgery ;**38,94 ,166**;24 Jun 93;Build 61 SROASSP ;B'HAM ISC/MAM - PRINT A COMPLETED ASSESSMENT ; [04/06/00 12:05 PM ] 2 ;;3.0; Surgery ;**38,94**;24 Jun 93 3 3 BATCH ; 4 4 W ! K DIR S DIR("?",1)="Enter YES to batch print all completed or transmitted assessments for a",DIR("?",2)="selected date range. Enter NO or press return to print one specific",DIR("?")="assessment." … … 7 7 S SRPRINT=1 K SRNEW D ^SROASS I '$D(SRTN) S SRSOUT=1 G END 8 8 W ! K %ZIS,IO("Q"),POP S %ZIS("A")="Print the Completed Assessment on which Device: ",%ZIS="Q" D ^%ZIS I POP S SRSOUT=1 G END 9 I $D(IO("Q")) K IO("Q") S ZTDESC="Completed Surgery Risk Assessment",ZTSAVE("SRSITE*")="",ZTSAVE("SRTN")="",ZTRTN= $S($P($G(^SRF(SRTN,"RA")),"^",2)="C":"EN^SROACOM1",1:"EN^SROACOM")D ^%ZTLOAD G END10 D @($S($P($G(^SRF(SRTN,"RA")),"^",2)="C":"EN^SROACOM1",1:"EN^SROACOM"))9 I $D(IO("Q")) K IO("Q") S ZTDESC="Completed Surgery Risk Assessment",ZTSAVE("SRSITE*")="",ZTSAVE("SRTN")="",ZTRTN="EN^SROACOM" D ^%ZTLOAD G END 10 D EN^SROACOM 11 11 END D ^%ZISC W @IOF K SRTN D ^SRSKILL 12 12 Q -
FOIAVistA/tag/r/SURGERY-SR/SROATCM3.m
r628 r636 1 SROATCM3 ;BIR/SJA - STUFF TRANMISSION IN ^TMP ; 12/03/072 ;;3.0; Surgery ;**125,135,153,164 ,166**;24 Jun 93;Build 61 SROATCM3 ;BIR/SJA - STUFF TRANMISSION IN ^TMP ;08/24/07 2 ;;3.0; Surgery ;**125,135,153,164**;24 Jun 93;Build 2 3 3 N SRDISP,NYUK S SRDISP="",NYUK=$P(SRRES(1),U,2),SRA(209.1)=$G(^SRF(SRTN,209.1)),SRA(207.1)=$G(^SRF(SRTN,207.1)) 4 4 I NYUK'="" D … … 14 14 S SHEMP=SHEMP_$J($P(SRA(209),"^",11),2)_$J(Y,5) 15 15 S X=$P(SRA(209),"^",12) S:X="" X="N" S SHEMP=SHEMP_$J(X,2) 16 ; CT Surgery Consult Date and cause for delay16 ; CT Surgery Consult Date 17 17 S SRDATE=$P(SRA(209),"^",15),SRDATE=$$LJ^XLFSTR(SRDATE,7,0),SHEMP=SHEMP_SRDATE 18 S X=$P(SRA(209),"^",16),SHEMP=SHEMP_$J(X,2)19 18 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1 20 19 LN27 ;Line #27 - Other Cardiac Procedures -
FOIAVistA/tag/r/SURGERY-SR/SROATM1.m
r628 r636 1 SROATM1 ;BIR/MAM - NON CARDIAC TRANSMISSION ; 12/10/072 ;;3.0; Surgery ;**27,38,47,60,62,81,88,93,95,125,153,160 ,166**;24 Jun 93;Build 61 SROATM1 ;BIR/MAM - NON CARDIAC TRANSMISSION ;05/10/07 2 ;;3.0; Surgery ;**27,38,47,60,62,81,88,93,95,125,153,160**;24 Jun 93;Build 7 3 3 ;** NOTICE: This routine is part of an implementation of a nationally 4 4 ;** controlled procedure. Local modifications to this routine … … 7 7 ; Reference to ^DIC(45.3 supported by DBIA #218 8 8 ; 9 N SRINTUB,SRDTH,SRPID ,SRCDT,SRCREQF I=0,200,200.1,206 S SRA(I)=$G(^SRF(SRTN,I))9 N SRINTUB,SRDTH,SRPID F I=0,200,200.1,206 S SRA(I)=$G(^SRF(SRTN,I)) 10 10 S DFN=$P(SRA(0),"^") N I D DEM^VADPT S SRANAME=VADM(1),SEX=$P(VADM(5),"^"),Z=$P(VADM(3),"^"),SRSDATE=$E($P(SRA(0),"^",9),1,12),Y=$E(SRSDATE,1,7),AGE=$E(Y,1,3)-$E(Z,1,3)-($E(Y,4,7)<$E(Z,4,7)) 11 11 S SRPID=VA("PID"),SRPID=$TR(SRPID,"-","") ; remove hyphens from PID 12 12 S X=$$SITE^SROUTL0(SRTN),SRDIV=$S(X:$P(^SRO(133,X,0),"^"),1:""),SRDIV=$S(SRDIV:$$GET1^DIQ(4,SRDIV,99),1:SRASITE) 13 13 S X=$P($G(^SRF(SRTN,205)),"^",3),SRDTH=$S(X:X,1:$P(VADM(6),"^")) 14 S SRCDT=$P($G(^SRF(SRTN,209)),"^",15),SRCREQ=$P($G(^SRF(SRTN,209)),"^",17) 15 S SHEMP=">"_$J(SRASITE,3)_$J(SRTN,7)_" 1"_DT_$J(AGE,3)_$J(SEX,1)_$J(SRSDATE,12)_$J(SRPID,20)_$J(SRDIV,6)_$J(SRDTH,12)_$J(SRCDT,7)_$J(SRCREQ,7) 14 S SHEMP=">"_$J(SRASITE,3)_$J(SRTN,7)_" 1"_DT_$J(AGE,3)_$J(SEX,1)_$J(SRSDATE,12)_$J(SRPID,20)_$J(SRDIV,6)_$J(SRDTH,12) 16 15 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 2",SRACNT=SRACNT+1 17 16 S NYUK=$P(SRA(200),"^",2) D ONE S SHEMP=SHEMP_MOE,NYUK=$P(SRA(200),"^",3) D ONE S SHEMP=SHEMP_MOE,NYUK=$P(SRA(200),"^",4) D ONE S SHEMP=SHEMP_MOE,NYUK=$P(SRA(200.1),"^",2) D ONE S SHEMP=SHEMP_MOE -
FOIAVistA/tag/r/SURGERY-SR/SROATMNO.m
r628 r636 1 SROATMNO ;BIR/MAM - TRANSMIT NO ASSESSMENT ; 12/18/072 ;;3.0; Surgery ;**27,38,47,62,68,79,83,81,88,93,95,97,129,125,142,153,160 ,166**;24 Jun 93;Build 61 SROATMNO ;BIR/MAM - TRANSMIT NO ASSESSMENT ;05/10/07 2 ;;3.0; Surgery ;**27,38,47,62,68,79,83,81,88,93,95,97,129,125,142,153,160**;24 Jun 93;Build 7 3 3 ;** NOTICE: This routine is part of an implementation of a nationally 4 4 ;** controlled procedure. Local modifications to this routine … … 15 15 I $P($G(^SRF(SRTN,30)),"^")!$P($G(^SRF(SRTN,31)),"^",8)!'$P($G(^SRF(SRTN,.2)),"^",12)!($P($G(^SRF(SRTN,"NON")),"^")="Y") K ^SRF("AQ",TDATE,SRTN) S $P(^SRF(SRTN,.4),"^",2)="" Q 16 16 I $P($G(^SRF(SRTN,"RA")),"^",6)="Y",$P($G(^SRF(SRTN,"RA")),"^",2)="N" K ^SRF("AQ",TDATE,SRTN) Q 17 I $P($G(^SRF(SRTN,0)),"^",9)="" K ^SRF("AQ",TDATE,SRTN) Q18 17 S SR10SP=" " K DA,DIE,DR S DA=SRTN,DIE=130,DR="905///R" D ^DIE K DR,DA,DIE 19 18 S SRA(0)=^SRF(SRTN,0),DATE=$E($P(SRA(0),"^",9),1,7),SPEC=$P(SRA(0),"^",4) S:SPEC SPEC=$P(^DIC(45.3,$P(^SRO(137.45,SPEC,0),"^",2),0),"^") … … 39 38 D OCC 40 39 S SRNODE=" X" S:$P($G(^SRF(SRTN,"RA")),U,6)="N" SRNODE=" *" S:$P($G(^SRF(SRTN,"RA")),U,2)="C" SRNODE=" C" 41 S SRTEMP="/"_$J(SRASITE,3)_$J(SRTN,7)_SRNODE_ $J(DATE,7)_$J(SRTECH,3)_$J(EMERG,1)_$J(SPEC,3)_$J(CPT,5)_$J(EXC,1)_$J(SRPID,20)_$J(SRDIV,6)_" "40 S SRTEMP="/"_$J(SRASITE,3)_$J(SRTN,7)_SRNODE_DATE_$J(SRTECH,3)_$J(EMERG,1)_$J(SPEC,3)_$J(CPT,5)_$J(EXC,1)_$J(SRPID,20)_$J(SRDIV,6)_" " 42 41 S SRTEMP=SRTEMP_$J(SRMAJMIN,1)_$J($E(SRDEATH,1,7),7)_$J(SRDTHUR,1)_$J(SRSTATUS,1)_$J(SRAGE,3)_$J(SRASA,2)_$J(SRADMIT,1)_SRTMP 43 42 K CPT,SRMOD F SRZ=1:1:10 S (CPT(SRZ),SRMOD(SRZ))="" -
FOIAVistA/tag/r/SURGERY-SR/SROAUTL.m
r628 r636 1 SROAUTL ;BIR/ADM - RISK ASSESSMENT UTILITY ;0 3/03/082 ;;3.0; Surgery ;**38,46,47,63,81,88,95,112,100,125,134,142,153,160 ,166**;24 Jun 93;Build 61 SROAUTL ;BIR/ADM - RISK ASSESSMENT UTILITY ;02/14/07 2 ;;3.0; Surgery ;**38,46,47,63,81,88,95,112,100,125,134,142,153,160**;24 Jun 93;Build 7 3 3 I $G(SRSUPCPT)=2 G NCODE 4 4 N SRCMOD,SRCOMMA,X K SRHDR S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S SRHDR=VADM(1)_" ("_VA("PID")_") Case #"_SRTN … … 42 42 I $$CARD,X="NA"!(X="NS") K X 43 43 Q 44 DATE ; called by output trans form on several date fields44 DATE ; called by output transmform on several date fields 45 45 I $D(Y),Y="NA"!(Y="NS") Q 46 46 N SRY S SRY=Y D DD^%DT … … 96 96 OCCEND K ^TMP("SROCC",$J) 97 97 Q 98 PREOP S DR="236;237;346;202;2 46;325;238;492;204;203;326;212;213;396;394;220;266;395;208;329;330;328;211;332;333;400;334;335;336;401;338;218;339;215;216;217;338.1;338.2;218.1;269"98 PREOP S DR="236;237;346;202;202.1;246;325;238;240;492;204;203;326;212;213;396;394;220;266;395;208;329;330;328;211;332;333;398;399;400;334;335;336;401;338;218;339;215;216;217;338.1;338.2;218.1;269" 99 99 Q 100 DEM S DR="413;.011;247;418;419;420;421;452;453;454;342 ;513;516"100 DEM S DR="413;.011;247;418;419;420;421;452;453;454;342" 101 101 Q 102 102 LAB S DR="270;304;224;291;223;290;225;292;228;295;227;294;229;296;230;297;234;301;231;298;233;300;232;299;487;487.1;274;305;405;407;275;306;406;408;277;308;278;309;279;310;280;311;281;312;283;314;455;455.1;456;456.1;444;444.1;445;445.1" -
FOIAVistA/tag/r/SURGERY-SR/SROAUTL1.m
r628 r636 1 SROAUTL1 ;BIR/ADM - RISK ASSESSMENT UTILITY ; 12/10/072 ;;3.0; Surgery ;**38,47,81,125,153,160 ,166**;24 Jun 93;Build 61 SROAUTL1 ;BIR/ADM - RISK ASSESSMENT UTILITY ;04/24/07 2 ;;3.0; Surgery ;**38,47,81,125,153,160**;24 Jun 93;Build 7 3 3 S SRZ=0 F S SRZ=$O(SRY(130,SRTN,SRZ)) Q:'SRZ I SRY(130,SRTN,SRZ,"I")="" D TR S X=$T(@SRP),SRFLD=$P(X,";;",2),SRX(SRZ)=$P(SRFLD,"^",2) 4 4 Q … … 15 15 CID ;;394^History of MI Within Past 6 Months (Y/N)^MI Within 6 Months^ 16 16 CIE ;;395^Angina within One Month Preceding Surgery (Y/N)^Angina Within 1 Month^ 17 CIH ;;398^Quadriplegia/Tetraplegia/Quadriparesis (Y/N)^Quadriplegia^ 18 CII ;;399^Paraplegia (Y/N)^Paraplegia^ 17 19 BCF ;;236^Patient's Height^Height^ 18 20 BCG ;;237^Patient's Weight^Weight^ 19 21 CDF ;;346^Diabetes^Diabetes Mellitus^ 20 22 BJB ;;202^Current Smoker within 1 Year prior to Surgery (Y/N)^Current SmokerW/I 1 Year^ 23 BJBPA ;;202.1^Pack/Years^Pack/Years^ 21 24 BDF ;;246^ETOH Greater than 2 Drinks/Day (Y/N)^ETOH > 2 Drinks/Day^ 22 25 CBE ;;325^Dyspnea^Dyspnea^ 23 26 BCH ;;238^DNR Status (Y/N)^DNR Status^ 27 BDJ ;;240^Functional Health Status Prior to Current Illness^Pre-Illness Functional Status^ 24 28 DIB ;;492^Functional Health Status at Evaluation for Surgery^Preop Functional Status 25 29 BJD ;;204^Ventilator Dependent Greater than 48 Hrs (Y/N)^Ventilator Dependent^ … … 59 63 DEC ;;453^Observation Discharge Date/Time 60 64 DED ;;454^Observation Treating Specialty 61 EAC ;;513^Surgery Consult Date62 EAF ;;516^Date Surgery Consult Requested -
FOIAVistA/tag/r/SURGERY-SR/SROAUTL3.m
r628 r636 1 SROAUTL3 ;BIR/ADM - RISK ASSESSMENT UTILITY ;0 1/07/082 ;;3.0; Surgery ;**38,47,63,77,142,163 ,166**;24 Jun 93;Build 61 SROAUTL3 ;BIR/ADM - RISK ASSESSMENT UTILITY ;08/16/07 2 ;;3.0; Surgery ;**38,47,63,77,142,163**;24 Jun 93;Build 2 3 3 ; 4 4 ; Reference to ^DIC(45.3 supported by DBIA #218 … … 15 15 Q 16 16 CARD ; allow input of cardiac risk assessment preop information 17 N SRSDATE,SRNM,SRSOUT18 17 W @IOF,!,"Enter Cardiac Preoperative information",!!," 1. Clinical Information",!," 2. Cardiac Catheterization & Angiographic Data",!," 3. Operative Risk Summary Data",! 19 18 K DIR S DIR(0)="NO^1:3:0",DIR("?")="Enter the number of the selection to be edited." D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y Q -
FOIAVistA/tag/r/SURGERY-SR/SROAUTL4.m
r628 r636 1 SROAUTL4 ;BIR/ADM - RISK ASSESSMENT UTILITY ;01/10/08 2 ;;3.0; Surgery ;**38,71,95,125,153,160,164,166**;24 Jun 93;Build 6 3 N SRZZ,SRXX,SRX1 1 SROAUTL4 ;BIR/ADM - RISK ASSESSMENT UTILITY ;08/24/07 2 ;;3.0; Surgery ;**38,71,95,125,153,160,164**;24 Jun 93;Build 2 4 3 S SRZ=0 F S SRZ=$O(SRY(130,SRTN,SRZ)) Q:'SRZ D 5 .I SRY(130,SRTN,SRZ,"I")="" D TR S (SRX1,X)=$T(@SRP),SRFLD=$P(X,";;",2) D 4 .I SRY(130,SRTN,SRZ,"I")="" D TR S X=$T(@SRP),SRFLD=$P(X,";;",2) D 5 ..I SRZ=451!(SRZ=450) S SRX($P(SRFLD,"^",2))=$P(SRFLD,"^",2)_"^"_SRZ Q 6 6 ..I SRZ=513,$P(^SRF(SRTN,0),"^",9)<3071001 Q 7 ..I SRZ=515 S X1=$P(^SRF(SRTN,0),"^",9),X2=$P($G(^SRF(SRTN,209)),"^",15) D ^%DTC I X'>30 Q 8 ..I SRZ=484,$P($G(^SRF(SRTN,209)),"^",13)'="Y" Q 9 ..S X=SRX1,SRX(SRZ)=$P(SRFLD,"^",2)_"^"_$P(X,";;",3) 7 ..S SRX(SRZ)=$P(SRFLD,"^",2) 10 8 .I SRY(130,SRTN,SRZ,"I")="NS" D TR S X=$T(@SRP),SRFLD=$P(X,";;",2),SRDT=$P(SRFLD,"^",4) S:SRDT'="" SRLR(SRDT)="" 11 9 S SRDT=0 F S SRDT=$O(SRLR(SRDT)) Q:'SRDT K SRX(SRDT) 12 Q13 RED M SRZZ=SRX S SRZ=0 F S SRZ=$O(SRX(SRZ)) Q:'SRZ S SRZZ=$P($G(SRX(SRZ)),"^",2),SRXX(SRZZ)=$P($G(SRX(SRZ)),"^")_":"_SRZ14 K SRX M SRX=SRXX K SRXX15 10 Q 16 11 TR S SRP=SRZ,SRP=$TR(SRP,"1234567890.","ABCDEFGHIJP") … … 18 13 GET S X=$T(@J) 19 14 Q 20 BCF ;;236^Patient's Height^Height^;;1-01 21 BCG ;;237^Patient's Weight^Weight^;;1-02 22 DGE ;;475^Diabetes (Cardiac);;1-03 23 B JC ;;203^History of COPD (Y/N)^COPD^;;1-0424 CD G ;;347^FEV1^FEV1^;;1-0525 BJ I ;;209^Cardiomegaly on Chest X-Ray (Y/N)^Cardiomegaly (X-ray)^;;1-0626 CD H ;;348^Pulmonary Rales (Y/N)^Pulmonary Rales^;;1-0727 EAJ ;;510^Current Smoker^Current Smoker^;;1-08 28 CD I ;;349^Active Endocarditis (Y/N)^Active Endocarditis^;;1-0929 CEJ ;;350^Resting ST Depression (Y/N)^Resting ST Depression^;;1-10 30 B DJ ;;240^Functional Health Status^Functional Status^;;1-1131 C EA ;;351^PCI Status^PCI^;;1-1232 BJE ;;205^Prior Myocardial Infarction^Prior MI^;;1-13 33 CEB ;;352^Number of Prior Heart Surgeries^Number of Prior Heart Surgeries^;;1-14 34 DHE ;;485^Prior Heart Surgeries;;1-15 35 B FE ;;265^Peripheral Vascular Disease (Y/N)^Peripheral Vascular Disease^;;1-1636 BFD ;;264^Cerebral Vascular Disease (Y/N)^Cerebral Vascular Disease^;;1-17 37 BF G ;;267^Angina (use NYHA Functional Class)^Angina (use CCS Class)^;;1-1838 B JG ;;207^Congestive Heart Failure (use NYHA Functional Class)^CHF (use NYHA Class)^;;1-1939 CEC ;;353^Current Diuretic Use (Y/N)^Current Diuretic Use^;;1-20 40 CED ;;354^Current Digoxin Use (Y/N)^Current Digoxin Use^;;1-21 41 CE E ;;355^IV NTG within 48 Hours Preceding Surgery (Y/N)^IV NTG within 48 Hours^;;1-2242 DGD ;;474^Preop use of circulatory Device;;1-23 43 DFC ;;463^Hypertension^;;1-24 44 DEG ;;457^HDL^^457.1;;2-01 45 DEGPA ;;457.1^HDL, Date;;2-02 46 DFA ;;461^LDL^^461.1;;2-03 47 DFAPA ;;461.1^LDL, Date;;2-04 48 DFB ;;462^Total Cholesterol^^462.1;;2-05 49 DFBPA ;;462.1^Total Cholesterol, Date;;2-06 50 DEH ;;458^Serum Triglyceride^^458.1;;2-07 51 DEHPA ;;458.1^Serum Triglyceride, Date;;2-08 52 DEI ;;459^Serum Potassium^^459.1;;2-09 53 DEIPA ;;459.1^Serum Potassium, Date;;2-10 54 D FJ ;;460^Serum Total Bilirubin^^460.1;;2-1155 DFJPA ;;460.1^Serum Total Bilirubin, Date;;2-12 56 BBC ;;223^Preoperative Serum Creatinine^Creatinine^290;;2-13 57 BIJ ;;290^Creatinine Date;;2-14 58 BBE ;;225^Preoperative Serum Albumin^^292;;2-15 59 BIB ;;292^Preoperative Serum Albumin Date;;2-16 60 BAI ;;219^Preoperative Hemoglobin^^239;;2-17 61 BCI ;;239^Preoperative Hemoglobin Date;;2-18 62 EJD ;;504^Hemoglobin A1c^^504.1;;2-19 63 EJDPA ;;504.1^Hemoglobin A1c, Date;;2-20 64 DGF ;;476^Procedure Type;;3-01 65 C EG ;;357^Left Ventricular End-Diastolic Pressure^LVEDP^;;3-0266 C EH ;;358^Aortic Systolic Pressure^Aortic Systolic Pressure^;;3-0367 C EI ;;359^PA Systolic Pressure^*PA Systolic Pressure^;;3-0468 C FJ ;;360^PAW Mean Pressure^*PAW Mean Pressure^;;3-0569 CFC ;;363^LV Contraction Grade^LV Contraction Grade (from contrast or radionuclide angiogram or 2D echo^;;3-06 70 DAE ;;415^Mitral Regurgitation^Mitral Regurgitation^;;3-07 71 DGG ;;477^Aortic Stenosis;;3-08 72 C FA ;;361^Left Main Stenosis^Left Main Stenosis^;;3-0973 C FBPA ;;362.1^Left Anterior Descending (LAD) Stenosis^LAD Stenosis^;;3-1074 C FBPB ;;362.2^Right Coronary Artery Stenosis^Right Coronary Stenosis^;;3-1175 C FBPC ;;362.3^Circumflex Coronary Artery Stenosis^Circumflex Stenosis^;;3-1276 DGH ;;478^Re-Do Lad Stenosis;;3-13 77 DGI ;;479^Re-Do Right Coronary Stenosis;;3-14 78 D HJ ;;480^Re-Do Circumflex Stenosis;;3-1579 CFD ;;364^Physician's Preoperative Estimate of Operative Mortality^Physician's Preoperative Estimate of Operative Mortality^;;4-01 80 CFDPA ;;364.1^Date/Time of Estimate of Operative Mortality^Date/Time of Estimate of Operative Mortality^;;4-02 81 APAC ;;1.13^ASA Class^ASA Classification^;;4-03 82 DAD ;;414^Cardiac Surgical Priority^Surgical Priority^;;4-04 83 DADPA ;;414.1^Date/Time of Cardiac Surgical Priority^Date/Time of Cardiac Surgical Priority^;;4-05 84 PBB ;;.22^Time the Operation Began^Date/Time Operation Began^;;4-06 85 PBC ;;.23^Time the Operation Ended^Date/Time Operation Ended^;;4-07 86 CFE ;;365^CABG Distal Anastomoses with Vein^^;;5-01 87 CFF ;;366^CABG Distal Anastomoses with IMA^^;;5-02 88 D FD ;;464^Number with Radial Artery^;;5-0389 D FE ;;465^Number with Other Artery^;;5-0490 D AF ;;416^CABG Distal Anastomoses with Other Conduit^^;;5-0591 CFG ;;367^Aortic Valve Replacement (Y/N)^Aortic Valve Replacement^;;5-06 92 CFH ;;368^Mitral Valve Replacement (Y/N)^Mitral Valve Replacement^;;5-07 93 CFI ;;369^Tricuspid Valve Replacement (Y/N)^Tricuspid Valve Replacement^;;5-08 94 CGJ ;;370^Valve Repair (Y/N)^Valve Repair^;;5-09 95 CGA ;;371^LV Aneurysmectomy (Y/N)^LV Aneurysmectomy^;;5-10 96 D HA ;;481^Bridge to transplant/Device;;5-1197 D HC ;;483^Transmyocardial Laser Revascularization;;5-1298 EAB ;;512^Maze Procedure;;5-13 99 CGF ;;376^ASD Repair (Y/N)^ASD Repair^;;5-14 100 CHJ ;;380^VSD Repair (Y/N)^VSD Repair^;;5-15 101 CGH ;;378^Myectomy for IHSS (Y/N)^Myectomy for IHSS^;;5-16 102 CGG ;;377^Myxoma Resection (Y/N)^Myxoma Resection^;;5-17 103 CGI ;;379^Other Tumor Resection (Y/N)^Other Tumor Resection^;;5-18 104 CGC ;;373^Cardiac Transplant (Y/N)^Cardiac Transplant^;;5-19 105 CGB ;;372^Great Vessel Repair(Y/N)^Great Vessel Repair^;;5-20 106 EJE ;;505^Endovascular Repair of Descending Thoracic Aorta (Y/N)^Endovascular Repair;;5-21107 EJB ;;502^Other Cardiac Procedures (Y/N);;5-22 108 D HD ;;484^Other cardiac procedures (specify);;5-23109 CHA ;;381^Foreign Body Removal (Y/N)^Foreign Body Removal^;;5-24 110 CHB ;;382^Pericardiectomy (Y/N)^Pericardiectomy^;;5-25 111 D EA ;;451^Total CPB Time;;5-26112 DEJ ;;450^Total Ischemic Time;;5-27 113 DFH ;;468^Incision Type^;;5-28 114 D FI ;;469^Covert From Off Pump to CPB;;5-29115 CHD ;;384^Operative Death (Y/N)^Operative Death^;;6-01 116 D AH ;;418^Hospital Admission Date And Time;;7-01117 D AI ;;419^Hospital Discharge Date And Time;;7-02118 D DJ ;;440^Cardiac Catheterization Date;;7-03119 PBJE ;;.205^Time Patient In OR;;7-04 120 PBCB ;;.232^Time Patient Out OR;;7-05 121 D GJ ;;470^Date and Time Patient Extubated;;7-06122 DGA ;;471^Date and Time Patient Discharged from ICU;;7-07 123 D GC ;;473^Homeless(Y/N);;7-08124 DGB ;;472^Cardiac Surgery to NON-VA Facility;;7-09 125 D DB ;;442^Employment Status;;7-10126 EAC ;;513^CT Surgery Consult Date;;7-11 127 EA E ;;515^Cause for Delay for Cardiac Surgery;;7-1215 PBB ;;.22^Time the Operation Began^Date/Time Operation Began^ 16 PBC ;;.23^Time the Operation Ended^Date/Time Operation Ended^ 17 BCF ;;236^Patient's Height^Height^ 18 BCG ;;237^Patient's Weight^Weight^ 19 CDF ;;346^Diabetes^Diabetes^ 20 BJC ;;203^History of COPD (Y/N)^COPD^ 21 CDG ;;347^FEV1^FEV1^ 22 BJI ;;209^Cardiomegaly on Chest X-Ray (Y/N)^Cardiomegaly (X-ray)^ 23 CDH ;;348^Pulmonary Rales (Y/N)^Pulmonary Rales^ 24 EAJ ;;510^Current Smoker^Current Smoker^ 25 BBC ;;223^Preoperative Serum Creatinine^Creatinine^290 26 CDI ;;349^Active Endocarditis (Y/N)^Active Endocarditis^ 27 CEJ ;;350^Resting ST Depression (Y/N)^Resting ST Depression^ 28 BDJ ;;240^Functional Health Status^Functional Status^ 29 CEA ;;351^PCI Status^PCI^ 30 BJE ;;205^Prior Myocardial Infarction^Prior MI^ 31 CEB ;;352^Number of Prior Heart Surgeries^Number of Prior Heart Surgeries^ 32 BFE ;;265^Peripheral Vascular Disease (Y/N)^Peripheral Vascular Disease^ 33 BFD ;;264^Cerebral Vascular Disease (Y/N)^Cerebral Vascular Disease^ 34 BFG ;;267^Angina (use NYHA Functional Class)^Angina (use CCS Class)^ 35 BJG ;;207^Congestive Heart Failure (use NYHA Functional Class)^CHF (use NYHA Class)^ 36 CEC ;;353^Current Diuretic Use (Y/N)^Current Diuretic Use^ 37 CED ;;354^Current Digoxin Use (Y/N)^Current Digoxin Use^ 38 CEE ;;355^IV NTG within 48 Hours Preceding Surgery (Y/N)^IV NTG within 48 Hours^ 39 CEF ;;356^Preoperative use of IABP (Y/N)^Preop Use of IABP^ 40 CEG ;;357^Left Ventricular End-Diastolic Pressure^LVEDP^ 41 CEH ;;358^Aortic Systolic Pressure^Aortic Systolic Pressure^ 42 CEI ;;359^PA Systolic Pressure^*PA Systolic Pressure^ 43 CFJ ;;360^PAW Mean Pressure^*PAW Mean Pressure^ 44 CFA ;;361^Left Main Stenosis^Left Main Stenosis^ 45 CFBPA ;;362.1^Left Anterior Descending (LAD) Stenosis^LAD Stenosis^ 46 CFBPB ;;362.2^Right Coronary Artery Stenosis^Right Coronary Stenosis^ 47 CFBPC ;;362.3^Circumflex Coronary Artery Stenosis^Circumflex Stenosis^ 48 CFC ;;363^LV Contraction Grade^LV Contraction Grade (from contrast or radionuclide angiogram or 2D echo^ 49 DAE ;;415^Mitral Regurgitation^Mitral Regurgitation^ 50 CFD ;;364^Physician's Preoperative Estimate of Operative Mortality^Physician's Preoperative Estimate of Operative Mortality^ 51 CFDPA ;;364.1^Date/Time of Estimate of Operative Mortality^Date/Time of Estimate of Operative Mortality^ 52 APAC ;;1.13^ASA Class^ASA Classification^ 53 DAD ;;414^Cardiac Surgical Priority^Surgical Priority^ 54 DADPA ;;414.1^Date/Time of Cardiac Surgical Priority^Date/Time of Cardiac Surgical Priority^ 55 CHD ;;384^Operative Death (Y/N)^Operative Death^ 56 CFE ;;365^CABG Distal Anastomoses with Vein^^ 57 CFF ;;366^CABG Distal Anastomoses with IMA^^ 58 CFG ;;367^Aortic Valve Replacement (Y/N)^Aortic Valve Replacement^ 59 CFH ;;368^Mitral Valve Replacement (Y/N)^Mitral Valve Replacement^ 60 CFI ;;369^Tricuspid Valve Replacement (Y/N)^Tricuspid Valve Replacement^ 61 CGJ ;;370^Valve Repair (Y/N)^Valve Repair^ 62 CGA ;;371^LV Aneurysmectomy (Y/N)^LV Aneurysmectomy^ 63 CGB ;;372^Great Vessel Repair(Y/N)^Great Vessel Repair^ 64 EJE ;;505^Endovascular Repair of Descending Thoracic Aorta (Y/N)^Endovascular Repair 65 CGC ;;373^Cardiac Transplant (Y/N)^Cardiac Transplant^ 66 CGF ;;376^ASD Repair (Y/N)^ASD Repair^ 67 CHJ ;;380^VSD Repair (Y/N)^VSD Repair^ 68 CGG ;;377^Myxoma Resection (Y/N)^Myxoma Resection^ 69 CHA ;;381^Foreign Body Removal (Y/N)^Foreign Body Removal^ 70 CGH ;;378^Myectomy for IHSS (Y/N)^Myectomy for IHSS^ 71 CHB ;;382^Pericardiectomy (Y/N)^Pericardiectomy^ 72 CGI ;;379^Other Tumor Resection (Y/N)^Other Tumor Resection^ 73 DAF ;;416^CABG Distal Anastomoses with Other Conduit^^ 74 DDB ;;442^Employment Status 75 BAI ;;219^Preoperative Hemoglobin^^239 76 BCI ;;239^Preoperative Hemoglobin Date 77 BBE ;;225^Preoperative Serum Albumin^^292 78 BIB ;;292^Preoperative Serum Albumin Date 79 BIJ ;;290^Creatinine Date 80 DEA ;;451^Total CPB Time 81 DEJ ;;450^Total Ischemic Time 82 DDJ ;;440^Cardiac Catheterization Date 83 DAH ;;418^Hospital Admission Date And Time 84 DAI ;;419^Hospital Discharge Date And Time 85 DFC ;;463^Hypertension^ 86 DFD ;;464^Number with Radial Artery^ 87 DFE ;;465^Number with Other Artery^ 88 DFH ;;468^Incision Type^ 89 DFI ;;469^Covert From Off Pump to CPB 90 DGJ ;;470^Date and Time Patient Extubated 91 DGA ;;471^Date and Time Patient Discharged from ICU 92 DGB ;;472^Cardiac Surgery to NON-VA Facility 93 PBJE ;;.205^Time Patient In OR 94 PBCB ;;.232^Time Patient Out OR 95 DEG ;;457^HDL^^457.1 96 DEGPA ;;457.1^HDL, Date 97 DEH ;;458^Serum Triglyceride^^458.1 98 DEHPA ;;458.1^Serum Triglyceride, Date 99 DEI ;;459^Serum Potassium^^459.1 100 DEIPA ;;459.1^Serum Potassium, Date 101 DFJ ;;460^Serum Total Bilirubin^^460.1 102 DFJPA ;;460.1^Serum Total Bilirubin, Date 103 DFA ;;461^LDL^^461.1 104 DFAPA ;;461.1^LDL, Date 105 DFB ;;462^Total Cholesterol^^462.1 106 DFBPA ;;462.1^Total Cholesterol, Date 107 EJD ;;504^Hemoglobin A1c^^504.1 108 EJDPA ;;504.1^Hemoglobin A1c, Date 109 DGE ;;475^Diabetes (Cardiac) 110 DGD ;;474^Preop use of circulatory Device 111 DGF ;;476^Procedure Type 112 DGG ;;477^Aortic Stenosis 113 DGH ;;478^Re-Do Lad Stenosis 114 DGI ;;479^Re-Do Right Coronary Stenosis 115 DHJ ;;480^Re-Do Circumflex Stenosis 116 DHA ;;481^Bridge to transplant/Device 117 EAB ;;512^Maze Procedure 118 DHC ;;483^Transmyocardial Laser Revascularization 119 EJB ;;502^Other Cardiac Procedures (Y/N) 120 DHD ;;484^Other cardiac procedures (specify) 121 DHE ;;485^Prior Heart Surgeries 122 EAC ;;513^CT Surgery Consult Date -
FOIAVistA/tag/r/SURGERY-SR/SROAUTLC.m
r628 r636 1 1 SROAUTLC ;BIR/ADM - CARDIAC RISK ASSESSMENT UTILITY ;08/23/07 2 ;;3.0; Surgery ;**38,71,90,88,95,97,102,96,125,153,163,164 ,166**;24 Jun 93;Build 62 ;;3.0; Surgery ;**38,71,90,88,95,97,102,96,125,153,163,164**;24 Jun 93;Build 2 3 3 ; 4 4 ; Reference to ^DIC(45.3 supported by DBIA #218 … … 43 43 Q 44 44 CHK ; check for missing cardiac assessment information 45 K SRX,SRZZ F SRC="CLIN","LAB","CATH","OP","CAR","OUT","R" K DA,DIC,DIQ,DR,SRY S DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="I" D @SRC D EN^DIQ1 D ^SROAUTL4 46 D RED^SROAUTL4 45 K SRX F SRC="CLIN","COC","CP","CLR" K DA,DIC,DIQ,DR,SRY S DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="I" D @SRC D EN^DIQ1 D ^SROAUTL4 47 46 Q 48 CLIN S DR="236;237;475;203;347;209;348;510; 349;350;240;351;205;352;485;265;264;267;207;353;354;355;474;463"47 CLIN S DR="236;237;475;203;347;209;348;510;223;290;219;239;225;292;349;350;240;351;205;352;485;265;264;267;207;353;354;355;463;474" 49 48 Q 50 C ATH S DR="476;357;358;359;360;363;415;477;361;362.1;362.2;362.3;478;479;480"49 COC S DR="476;477;357;358;359;360;361;362.1;362.2;362.3;363;415;474;364;364.1;1.13;414;414.1;384;.22;.23;472;478;479;480" 51 50 Q 52 R S DR="418;419;440;.205;.232;470;471;473;472;442;513;515" 53 Q 54 OP S DR="364;364.1;1.13;414;414.1;.22;.23" 55 Q 56 OUT S DR="384" 57 Q 58 CAR S DR="365;366;464;465;416;367;368;369;370;371;481;483;512;376;380;378;377;379;373;372;505;502;381;382;451;450;468;469" 51 CP S DR="365;366;464;465;416;367;368;369;370;371;372;505;450;451;373;376;380;377;381;378;382;379;468;469;.205;.232;470;471;418;419;440;481;512;483;502;513" 59 52 I $P($G(^SRF(SRTN,209)),"^",13)="Y"!($P($G(^SRF(SRTN,209)),"^",13)="") S DR=DR_";484" 60 53 Q 61 LAB S DR="457;457.1;461;461.1;462;462.1;458;458.1;459;459.1;460;460.1;223;290;225;292;219;239;504;504.1"54 CLR S DR="457;457.1;458;458.1;459;459.1;460;460.1;461;461.1;462;462.1;504;504.1" 62 55 Q -
FOIAVistA/tag/r/SURGERY-SR/SROCODE.m
r628 r636 1 SROCODE ;B IR/MAM - SET UP FLAG FOR ANESTHESIA AGENTS ;01/30/082 ;;3.0; Surgery ;**72,41,114,151 ,166**;24 Jun 93;Build 61 SROCODE ;B'HAM ISC/MAM - SET UP FLAG FOR ANESTHESIA AGENTS ; [ 05/06/98 7:14 AM ] 2 ;;3.0; Surgery ;**72,41,114,151**;24 Jun 93 3 3 ; 4 4 ; Reference to ENS^PSSGIU supported by DBIA #895 5 ; Reference to ^PSS50 supported by DBIA #4533 5 6 ; 6 1 N SRTEST S SRTEST=50,SRTEST(0)="AEQSZ",SRTEST("A")="Enter the name of the drug you wish to flag: " 7 D DIC^PSSDI(50,"SR",.SRTEST) G:+Y<1 DONE S SROIUDA=+Y,SROIRX=$P(Y,"^",2),SROIUX="S^SURGERY" D SROIU 7 1 W !! K DIR S DIR(0)="P^50:QEAM",DIR("A")="Enter the name of the drug you wish to flag" D ^DIR G:Y<1 DONE S SROIUDA=+Y,SROIRX=$P(Y,"^",2),SROIUX="S^SURGERY" D SROIU 8 8 G 1 9 9 SROIU Q:'$D(SROIUDA)!'$D(SROIUX) Q:SROIUX'?1E1"^"1.E -
FOIAVistA/tag/r/SURGERY-SR/SROESPR1.m
r628 r636 1 1 SROESPR1 ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 04/21/04 12:08 PM ] 2 ;;3.0; Surgery ;**100,128 ,162**;24 Jun 93;Build 42 ;;3.0; Surgery ;**100,128**;24 Jun 93 3 3 ; 4 4 ;** NOTICE: This routine is part of an implementation of a nationally … … 98 98 . S SRY=4 D SETCONT() Q:'SRCONT 99 99 . W !!,$$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"ADDENDUM" 100 . W ?41,"STATUS: ",^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,.05,"E")101 100 . S SRI=0 102 101 . F S SRI=$O(^TMP("SRLQ",$J,SRDA,"ZADD",SRADD,"TEXT",SRI)) Q:SRI'>0 D Q:'SRCONT -
FOIAVistA/tag/r/SURGERY-SR/SROGMTS.m
r628 r636 1 1 SROGMTS ;BIR/ADM - SURGERY HEALTH SUMMARY ; [ 08/08/01 7:12 AM ] 2 ;;3.0; Surgery ;**100,127 ,162**;24 Jun 93;Build 42 ;;3.0; Surgery ;**100,127**;24 Jun 93 3 3 ; 4 4 ;** NOTICE: This routine is part of an implementation of a nationally … … 22 22 S:'SRSG DR=".09;.31;26;27;33;50;55;59;66;121;122;123;124;125" 23 23 D EN^DIQ1 S REC(130,IEN,"STATUS")=$$OS(IEN) S:+SRSG REC(130,IEN,"VERIFIED")=$S($G(REC(130,IEN,43,"I"))'="Y":"(Unverified)",1:"") 24 S SRM=$G(REC(130,IEN,27,"I")) I SRM>0 D CPT(SRM,$P($G(^SRF(IEN,0)),"^",9),130,27) 25 D DICT^SROGMTS0,SUB,SPD 24 S SRM=$G(REC(130,IEN,27,"I")) I SRM>0 D 25 . S SRC=$$CPT^ICPTCOD(SRM,$P($G(^SRF(IEN,0)),"^",9)),(SRCS,SRS)=$$EN2^SROGMTS0($P(SRC,"^",3)) 26 . S REC(130,IEN,27,"X")=$P(SRC,"^",2)_"^"_$P(SRC,"^",3) 27 . S SRC=$P(SRC,"^",2),SRT=$$EN2^SROGMTS0($G(REC(130,IEN,26,"E"))) 28 . S:$L(SRS)&(SRS'=SRT) SRT=SRT_" - "_SRS 29 . S:$L(SRC)=5 SRT=SRT_" (CPT "_SRC_")",SRCS=SRCS_" (CPT "_SRC_")" 30 . S REC(130,IEN,27,"N")=SRS 31 . S (REC(130,IEN,26,"S"),REC(130,IEN,27,"S"))=SRT 32 . S REC(130,IEN,27,"S")=SRCS 33 D DICT^SROGMTS0,SUB 26 34 S:$D(REC(130,IEN,32)) REC(130,IEN,32,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,32,"E"))) 27 35 S:$D(REC(130,IEN,33)) REC(130,IEN,33,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,33,"E"))) … … 104 112 . . S DA(SUB)=SRI 105 113 . . D EN^DIQ1 106 . . S SRM=+($G(REC(130,+($G(IEN)),SUB,+($G(SRI)),.01,"I"))) I SRM>0 D MOD(SRM,FILE,SUB) 114 . . S SRM=+($G(REC(130,+($G(IEN)),SUB,+($G(SRI)),.01,"I"))) 115 . . I SRM>0 N SRMOD D 116 . . . S SRMOD=$$MOD^ICPTMOD(+SRM,"I",$P($G(^SRF(IEN,0)),"^",9)) 117 . . . S SRC=$P(SRMOD,"^",2) 118 . . . S SRS=$P(SRMOD,"^",3) 119 . . . S REC(130,IEN,SUB,SRI,.01,"MID")=SRC 120 . . . S REC(130,IEN,SUB,SRI,.01,"MOD")=SRS 121 . . . S SRT=$$EN2^SROGMTS0(SRS) 122 . . . S:$L(SRC) SRT=SRT_" (CPT Mod "_SRC_")" 123 . . . S REC(130,IEN,SUB,SRI,.01,"S")=SRT 107 124 ; 108 125 ; ^SRF(DO,13,I) .42 Other Proc 13;0 130.16 … … 147 164 SG(X) ; Surgical (Operative) Record 148 165 S X=$$GET1^DIQ(130,+($G(X)),118,"I") S X=$S(X["Y":0,1:1) Q X 149 CPT(SRM,SRDOO,SRFIL,SRFLD) ;Set CPT code into REC array150 S SRC=$$CPT^ICPTCOD(SRM,SRDOO),(SRCS,SRS)=$$EN2^SROGMTS0($P(SRC,"^",3))151 S REC(SRFIL,IEN,SRFLD,"X")=$P(SRC,"^",2)_"^"_$P(SRC,"^",3)152 S SRC=$P(SRC,"^",2),SRT=$$EN2^SROGMTS0($G(REC(130,IEN,26,"E")))153 S:$L(SRS)&(SRS'=SRT) SRT=SRT_" - "_SRS154 S:$L(SRC)=5 SRT=SRT_" (CPT "_SRC_")",SRCS=SRCS_" (CPT "_SRC_")"155 S REC(SRFIL,IEN,SRFLD,"N")=SRS156 S:SRFIL=130 REC(130,IEN,26,"S")=SRT157 S REC(SRFIL,IEN,SRFLD,"S")=SRT158 S REC(SRFIL,IEN,SRFLD,"S")=SRCS159 Q160 MOD(SRM,SRFIL,SUB) ;Set CPT Modifier into REC array161 S SRMOD=$$MOD^ICPTMOD(+SRM,"I",$P($G(^SRF(IEN,0)),"^",9))162 S SRC=$P(SRMOD,"^",2)163 S SRS=$P(SRMOD,"^",3)164 S REC(SRFIL,IEN,SUB,SRI,.01,"MID")=SRC165 S REC(SRFIL,IEN,SUB,SRI,.01,"MOD")=SRS166 S SRT=$$EN2^SROGMTS0(SRS)167 S:$L(SRC) SRT=SRT_" (CPT Mod "_SRC_")"168 S REC(SRFIL,IEN,SUB,SRI,.01,"S")=SRT169 Q170 SPD ;Obtain Surgery Procedure/Diagnosis Code File entry171 S (FILE,DIC)=136,DA=+($G(IEN)),DIQ="REC(",DIQ(0)="IE"172 S DR=".01;.02;.03;10"173 D EN^DIQ1174 Q:'+$G(REC(FILE,IEN,10,"I"))175 S SRM=+$G(REC(FILE,IEN,.02,"I"))176 Q:'(SRM>0) D CPT(SRM,$P($G(^SRF(IEN,0)),"^",9),FILE,.02)177 S SUB=136.01,DR=1,DR(SUB)=".01",DIQ="REC(136,"_IEN_","178 K REC(FILE,IEN,SUB) S SRI=0 F S SRI=$O(^SRO(FILE,(+$G(IEN)),DR,SRI)) Q:+SRI=0 D179 .S DA(SUB)=SRI180 .D EN^DIQ1181 .S SRM=REC(FILE,IEN,SUB,SRI,.01,"I") I SRM>0 D MOD(SRM,FILE,SUB)182 N DA S DA=IEN,SUB=136.011,DR=11,DR(SUB)=".01;1"183 K REC(FILE,IEN,SUB) S SRI=0 F S SRI=$O(^SRO(FILE,(+$G(IEN)),DR,SRI)) Q:+SRI=0 D184 . S DA(SUB)=SRI185 . D EN^DIQ1186 S $P(REC(130,IEN,26,"S"),"-",2)=" "_REC(FILE,IEN,.02,"S")187 K REC(130,IEN,130.028) M REC(130,IEN,130.028)=REC(FILE,IEN,136.01)188 Q -
FOIAVistA/tag/r/SURGERY-SR/SROMED.m
r628 r636 1 SROMED ;BIR/MAM - ENTER/EDIT MEDICATIONS ;01/30/08 2 ;;3.0; Surgery ;**21,44,79,100,151,166**;24 Jun 93;Build 6 1 SROMED ;B'HAM ISC/MAM - ENTER/EDIT MEDICATIONS ; [ 01/30/01 12:22 AM ] 2 ;;3.0; Surgery ;**21,44,79,100,151**;24 Jun 93 3 ; 4 ; Reference to ^PSDRUG supported by DBIA #221 3 5 ; 4 6 I '$D(^XUSEC("SROEDIT",DUZ))&'$D(^XUSEC("SROANES",DUZ)) W !!!,$C(7),"You must hold the SROEDIT key or the SROANES key to use this option !",! Q … … 10 12 I M?.E1C.E W !!,"Your answer has a control character in it, please re-type it.",! D RET G:SRQ END G START 11 13 S (X,SRMM)=SRM D 12 .N SRDIC,SRD S SRDIC=50,SRDIC(0)="EMQSZ",SRD="B^C" D MIX^PSSDI(50,"SR",.SRDIC,SRD,X,,DT) 14 .I $L($T(SCREEN^PSSDI)) N SRTEST S SRTEST=50,SRTEST(0)="EQSZ" D DIC^PSSDI(50,"SR",.SRTEST,X,,DT) Q ;call PSSDI if PSS*1*104 is released 15 .S DIC="^PSDRUG(",DIC(0)="QEZM",DIC("S")="I $S('$G(^PSDRUG(Y,""I"")):1,DT'>^(""I""):1,1:0)" D ^DIC K DIC 13 16 S SRM=$S(Y<0:"",1:$P(Y,"^",2)) 14 17 I SRM="",SRMM'["?" W !!,"The Drug '",SRMM,"' does not exist in your Drug file. Please re-enter. " D RET G:SRQ END G START … … 42 45 D1 I SRF=1 R !!,"ENTER DOSE: ",SRD1:DTIME S:'$T SRD1="^" K:SRD1["^" SRD Q:SRD1["^" W:SRD1["?" !!,"Dosage must be 1 to 15 characters in length" G:SRD1["?" D1 S SRD=SRD1,SRF=0 G DOSE 43 46 Q 44 SCR(SRFL,SRPK) ; screening for fields point to the DRUG file (#50)45 N SRDT,SRN0,SRNODE,SROK,SRY S SROK=0,SRY=+Y K ^TMP($J,"SR")46 I $G(SRFL)=1 S SRTN=$S($G(SRTN):SRTN,1:DA),SRN0=$G(^SRF(SRTN,0)),SRDT=$S($P(SRN0,"^",9):$P($P(SRN0,"^",9),"."),1:DT)47 D DATA^PSS50(SRY,,$S($G(SRFL):SRDT,1:""),,,"SR")48 I SRPK="S" D Q SROK49 .S SRNODE=$P($G(^TMP($J,"SR",SRY,63)),"^") K ^TMP($J,"SR") I SRNODE["S" S SROK=150 S SROK=$S($P($G(^TMP($J,"SR",0)),"^")=-1:0,1:1) K ^TMP($J,"SR") Q SROK -
FOIAVistA/tag/r/SURGERY-SR/SROWL.m
r628 r636 1 SROWL ;B'HAM ISC/MAM - ENTER PATIENT ON WAITING LIST ; 4/18/07 11:55am 2 ;;3.0;Surgery;**58,119,162**;24 Jun 93;Build 4 3 ; 1 SROWL ;B'HAM ISC/MAM - ENTER PATIENT ON WAITING LIST ;13 Feb 1989 11:32 AM 2 ;;3.0;Surgery;**58,119**;24 Jun 93 4 3 ENTER ; enter a patient on the waiting list 5 4 S SRSOUT=0 W @IOF K DIC S DIC(0)="QEAMZL",(DIC,DLAYGO)=133.8,DIC("A")=" Select Surgical Specialty: " D ^DIC K DIC,DLAYGO G:Y<0 END S SRSS=+Y,SRSS1=+Y(0) … … 74 73 S SRDEMO(5)=SRDEMO(200,SRNPREC,".132") ;Office Phone 75 74 ; Set up DR array that FileMan will use, with a call to ^DIE, after this subroutine Quits to "stuff" the demographic data. 76 ; all fields except STATE will ignore input transform (SR*3.0*162) 77 S DIC("DR")="1////"_SRDEMO(1)_";2////"_SRDEMO(2)_";3///"_SRDEMO(3)_";4////"_SRDEMO(4)_";5////"_SRDEMO(5)_";6////"_$P(Y,U,1) 75 S DIC("DR")="1///"_SRDEMO(1)_";2///"_SRDEMO(2)_";3///"_SRDEMO(3)_";4///"_SRDEMO(4)_";5///"_SRDEMO(5)_";6///"_$P(Y,U,1) 78 76 S DIC(0)="Z" ;Tells FileMan to file the data without any more user input 79 77 Q -
FOIAVistA/tag/r/SURGERY-SR/SROXR4.m
r628 r636 1 SROXR4 ;BIR/MAM - CROSS REFERENCES ; 11/05/072 ;;3.0; Surgery ;**62,83,100,153 ,166**;24 Jun 93;Build 61 SROXR4 ;BIR/MAM - CROSS REFERENCES ;03/15/06 2 ;;3.0; Surgery ;**62,83,100,153**;24 Jun 93;Build 11 3 3 Q 4 4 PRO ; stuff default prosthesis info … … 56 56 N SRTD,SRLO D AQDT K ^SRF("AQ",SRTD,DA) 57 57 Q 58 AT ; set logic for AT x-ref on DATE OF LAST TRANSMISSION59 N SRX S ^SRF("AT",X,DA)=""60 S SRX=$P($G(^SRF(DA,"RA")),"^",4) I SRX,SRX'=X K ^SRF("AT",SRX,DA)61 Q62 KAT ; kill logic for AT x-ref on DATE OF LAST TRANSMISSION63 N SRX K ^SRF("AT",X,DA)64 S SRX=$P($G(^SRF(DA,"RA")),"^",4) I SRX,SRX'=X K ^SRF("AT",SRX,DA)65 Q66 AT1 ; set logic for AT x-ref on DATE TRANSMITTED67 N SRX S SRX=$P($G(^SRF(DA,"RA")),"^",8) I SRX Q68 S ^SRF("AT",X,DA)=""69 Q70 KAT1 ; kill logic for AT x-ref on DATE TRANSMITTED71 N SRX S SRX=$P($G(^SRF(DA,"RA")),"^",8)72 I SRX'=X K ^SRF("AT",X,DA)73 Q
Note:
See TracChangeset
for help on using the changeset viewer.
