source: FOIAVistA/trunk/r/SURGERY-SR/SROASWP3.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1SROASWP3 ;B'HAM ISC/MAM - MANUAL MATCH RISK DATA ; 14 APR 1992 11:15 am
2 ;;3.0; Surgery ;;24 Jun 93
3 S SRA(0)=^SRA(SRAN,0),DFN=$P(SRA(0),"^"),(SDATE,X1)=$P(SRA(0),"^",5),X2=60 D C^%DTC S SRUPPER=X,X2=-60,X1=SDATE D C^%DTC S SRLOWER=X
4 D DEM^VADPT S SRNAME=VADM(1) K VADM
5 S SROPER=$P(^SRA(SRAN,"OP"),"^") K SROPS S:$L(SROPER)<65 SROPS(1)=SROPER I $L(SROPER)>64 S SROPER=SROPER_" " K M,MM,MMM F M=1:1 D LOOP Q:MMM=""
6 W @IOF,!,"PATIENT: "_SRNAME,?50,"DATE OF OPERATION: "_$E(SDATE,4,5)_"/"_$E(SDATE,6,7)_"/"_$E(SDATE,2,3),!,"ASSESSMENT NUMBER: "_SRAN,!,"PROCEDURE: "_SROPS(1) I $D(SROPS(2)) W !,?12,SROPS(2) I $D(SROPS(3)) W !,?12,SROPS(3)
7 W ! F LINE=1:1:80 W "-"
8 W ! K SRCASE S (SRTN,CNT)=0 F S SRTN=$O(^SRF("B",DFN,SRTN)) Q:'SRTN D CHECK I CASE S SROP=SRTN D LIST
9 I '$D(SRCASE(1)) W !!,"There were no Surgery cases for "_SRNAME_" within the 60 days before",!,"or after the date of operation entered in this assessment." D DELETE Q
10 I '$D(SRCASE(2)) D ONLYONE Q
11 W !! F LINE=1:1:80 W "-"
12SEL W !!,"Select the NUMBER corresponding to the ",!,"Surgery Case that this Assessment matches: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
13 I X="" D DELETE S:SRSOUT SRSOUT=0 Q
14 I '$D(SRCASE(X)) W !!,"Enter the number that corresponds to the Surgery case that this assessment ",!,"matches. If the assessment does not relate to any of the cases listed above,",!,"enter RETURN at the prompt." G SEL
15MATCH W !!,"Are you sure that this is the correct Surgery Case ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
16 S SRYN=$E(SRYN) I "YyNn"'[SRYN W !!,"Enter 'YES' to convert the assessemnt into the Surgery file, or 'NO' to make",!,"another selection." G MATCH
17 I "Yy"[SRYN S OK=1,SRTN=SRCASE(X) W !!,"Converting Risk Assessment Information..."
18 Q
19CHECK ; check for dates within 60 days of procedure
20 S CASE=0,SRSDATE=$P(^SRF(SRTN,0),"^",9)
21 I SRSDATE<SRLOWER Q
22 I SRSDATE>SRUPPER Q
23 S CASE=1
24 Q
25LIST ; list cases
26 I $P($G(^SRF(SROP,"NON")),"^")="Y" Q
27 S SRSCAN=1 I $D(^SRF(SROP,.2)),$P(^(.2),"^",12)'="" K SRSCAN
28 I $D(SRSCAN),$D(^SRF(SROP,30)),$P(^(30),"^") Q
29 I $D(SRSCAN),$D(^SRF(SROP,31)),$P(^(31),"^",8) Q
30 I $D(^SRF(SROP,37)),$P(^(37),"^") Q
31 S CNT=CNT+1,SRSDATE=$P(^SRF(SROP,0),"^",9)
32 W !,CNT_". "
33CASE W $E(SRSDATE,4,5)_"-"_$E(SRSDATE,6,7)_"-"_$E(SRSDATE,2,3)
34 S SROPER=$P(^SRF(SROP,"OP"),"^") I $O(^SRF(SROP,13,0)) S SROTHER=0 F I=0:0 S SROTHER=$O(^SRF(SROP,13,SROTHER)) Q:'SROTHER D OTHER
35 D ^SROP1 K SROPS,MM,MMM S:$L(SROPER)<65 SROPS(1)=SROPER I $L(SROPER)>64 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
36 W ?14,SROPS(1) I $D(SROPS(2)) W !,?14,SROPS(2) I $D(SROPS(3)) W !,?14,SROPS(3) W:$D(SROPS(4)) !,?14,SROPS(4)
37 W ! S SRCASE(CNT)=SROP
38 Q
39OTHER ; other operations
40 S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SROP,13,SROTHER,0),"^"))>235 S SRLONG=0,SROTHER=999,SROPERS=" ..."
41 I SRLONG S SROPERS=$P(^SRF(SROP,13,SROTHER,0),"^")
42 S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)
43 Q
44LOOP ; break procedures
45 S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<65 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
46 Q
47ONLYONE ; match if only one case
48 W !!,"Do you want to match the Risk Assessment with this Surgical Case ? NO// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
49 S SRYN=$E(SRYN) I "YyNn"'[SRYN W !!,"Enter 'YES' to move the Risk Assessment information into this surgical case,",!,"or 'NO' if the information does not relate to this surgical case." G ONLYONE
50 I "Nn"'[SRYN S SRTN=SRCASE(1),OK=1 W !!,"Converting Risk Assessment Information..." Q
51DELETE ; delete assessment
52 W !!,"Since this assessment cannot be matched to any Surgery case, it must be",!,"deleted.",!!,"Are you sure that you want to delete this assessment ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
53 S SRYN=$E(SRYN) I SRYN="" S SRYN="Y"
54 I "YyNn"'[SRYN W !!,"Enter 'YES' to delete this assessment from the SURGERY RISK ASSESSMENT",!,"file (139), or 'NO' to continue matching other assessments." G DELETE
55 I "Yy"'[SRYN Q
56 K DA,DIK S DA=SRAN,DIK="^SRA(" W !!,"Deleting assessment from SURGERY RISK ASSESSMENT file (139)..." D ^DIK
57 W !!,"Press RETURN to continue " R X:DTIME
58 Q
Note: See TracBrowser for help on using the repository browser.