source: WorldVistAEHR/trunk/r/SURGERY-SR/SROXRET.m@ 623

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1SROXRET ;B'HAM ISC/MAM - UNEXPECTED RETURNS ; 17 JAN 1991 9:00 AM
2 ;;3.0; Surgery ;**16,34,46**;24 Jun 93
3 N SRSDATE S SRSDATE=$P(^SRF(SRTN,0),"^",9),X1=SRSDATE,X2=-30 D C^%DTC S SRDATES=X-.0001 I $P(SRSDATE,".",2)="" S SRSDATE=SRSDATE+.9999
4 S CNT=0,DFN=$P(^SRF(SRTN,0),"^") F S SRDATES=$O(^SRF("AC",SRDATES)) Q:'SRDATES!(SRDATES>SRSDATE) S SRETURN=0 F S SRETURN=$O(^SRF("AC",SRDATES,SRETURN)) Q:'SRETURN I ^(SRETURN)=DFN,DA'=SRETURN D SET
5 I '$O(SRETURN(0)) Q
6 I '$D(SRETURN(2)) D ONE Q:X="" S SRELATE="R" G STUFF
7ASK W !!,"Is this a return to surgery related to one of the cases listed",!,"above ? NO// " R SRYN:DTIME I '$T!(SRYN["^") W @IOF Q
8 S SRYN=$E(SRYN) S:SRYN="" SRYN="N" I "Nn"[SRYN W @IOF Q
9 I "Yy"'[SRYN D HELP G ASK
10SEL W !!,"Select the number corresponding to the appropriate case: " R X:DTIME I '$T!("^"[X) W @IOF Q
11 I '$D(SRETURN(X)) W !!,"Enter the number corresponding to the operative procedure associated with",!,"this unexpected return to surgery." G SEL
12 S SRELATE="R"
13STUFF S SRETURN=$P(SRETURN(X),"^") I '$D(^SRF(SRETURN,29,0)) S ^(0)="^130.43PA^^0"
14 K DA,D0,DD,DINUM,DIC S DA(1)=SRETURN,DIC="^SRF("_SRETURN_",29,",(DINUM,X)=SRTN,DIC(0)="L",DLAYGO=130.43 D FILE^DICN K DIC,DINUM,DLAYGO
15 S $P(^SRF(SRETURN,29,SRTN,0),"^",3)=SRELATE,DA=SRTN
16 W:SRELATE="R" @IOF Q
17ONE S X="" W !!,"Is this a return to surgery related to the case listed ",!,"above ? NO// " R SRYN:DTIME I '$T!(SRYN["^") W @IOF Q
18 S SRYN=$E(SRYN) S:SRYN="" SRYN="N" I "Nn"[SRYN S X="" W @IOF Q
19 I "Yy"'[SRYN D HELP G ONE
20 S X=1
21 Q
22SET I $D(^SRF(SRETURN,29,SRTN,0))!'$D(^SRF(SRETURN,.2)) Q
23 I '$P(^SRF(SRETURN,.2),"^",12) Q
24 S CNT=CNT+1,SRETURN(CNT)=SRETURN_"^"_SRDATES_"^"_$P(^SRF(SRETURN,"OP"),"^")
25 S Y=SRDATES D D^DIQ S OPDATE=$P(Y,"@")
26 S SROPER=$P(^SRF(SRETURN,"OP"),"^") K SROP,MM,MMM
27 S:$L(SROPER)<50 SROP(1)=SROPER I $L(SROPER)>49 F MAM=1:1 D LOOP Q:'MMM
28 I CNT=1 D DEM^VADPT W @IOF,!,"Completed cases for "_VADM(1)_" within the past 30 days:",!!
29 W !,CNT_".",?5,OPDATE,?25,SROP(1) I $D(SROP(2)) W !,?25,SROP(2) I $D(SROP(3)) W !,?25,SROP(3) I $D(SROP(4)) W !,?25,SROP(4)
30 S X=CNT,SRELATE="U" D STUFF
31 Q
32HELP W !!,"If this surgical case is related to a previous case, enter 'YES'. Otherwise, ",!,"press RETURN to continue entering information for this operative procedure."
33 Q
34LOOP ; break procedure if greater than 50 characters
35 S SROP(MAM)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROP(MAM))+$L(MM)'<50 S SROP(MAM)=SROP(MAM)_MM_" ",SROPER=MMM
36 Q
Note: See TracBrowser for help on using the repository browser.