| [613] | 1 | SROSCH ;B'HAM ISC/MAM - SCHEDULE OF OPERATIONS ; [ 09/22/98  11:48 AM ]
 | 
|---|
 | 2 |  ;;3.0; Surgery ;**19,48,63,50**;24 Jun 93
 | 
|---|
 | 3 |  U IO S (SRQ,TOTAL)=0,(SRFLG,SRPAGE)=1,SRINST=SRSITE("SITE"),SRCHF=$P(^SRO(133,SRSITE,0),"^",10) D HDR^SROSCH1
 | 
|---|
 | 4 |  S SROR=0 F  S SROR=$O(^SRF("AMM",SROR)) Q:'SROR!(SRQ)  I $$ORDIV^SROUTL0(SROR,$G(SRSITE("DIV"))) S SX=0,SRDTS=SRDT-.0001 F  S SRDTS=$O(^SRF("AMM",SROR,SRDTS)) Q:SRDTS=""!(SRDTS>(SRDT+.9999))!(SRDTS<(SRDT-.0001))!SRQ  D MORE
 | 
|---|
 | 5 |  I 'SRFLG D
 | 
|---|
 | 6 |  .I $Y+5>IOSL S SX=1 D ASK^SROSCH1
 | 
|---|
 | 7 |  .W !,"TOTAL CASES SCHEDULED: "_TOTAL
 | 
|---|
 | 8 |  I SRFLG W !!,"No operations scheduled for this date."
 | 
|---|
 | 9 |  I $E(IOST)'="P",'SRQ W !!,"Press RETURN to continue  " R X:DTIME
 | 
|---|
 | 10 |  G END
 | 
|---|
 | 11 | MORE ; continue looping on SC cross reference
 | 
|---|
 | 12 |  S (SRFLG,SRTN)=0 F  S SRTN=$O(^SRF("AMM",SROR,SRDTS,SRTN)) Q:'SRTN!(SRQ)  I $$DIV^SROUTL0(SRTN) S SX=SX+1,TOTAL=TOTAL+1 D SET
 | 
|---|
 | 13 |  Q
 | 
|---|
 | 14 | SET ; set variables
 | 
|---|
 | 15 |  S S(0)=^SRF(SRTN,0),DFN=$P(S(0),"^") D DEM^VADPT S SRNM=VADM(1),SRSSN=VA("PID"),AGE=VADM(4)
 | 
|---|
 | 16 |  S S(.1)=$G(^SRF(SRTN,.1)),S(.3)=$G(^SRF(SRTN,.3)),S("1.0")=$G(^SRF(SRTN,"1.0")),SRPX=$P(S("1.0"),"^",2)
 | 
|---|
 | 17 |  I $L(SRNM)>23 S SRNM=$P(SRNM,",")_", "_$E($P(SRNM,",",2))
 | 
|---|
 | 18 |  S SROOM=$P(^SRS(SROR,0),"^"),SROOM=$P(^SC(SROOM,0),"^")
 | 
|---|
 | 19 |  S SRIX=$P(S("1.0"),"^",5),Y=$P(S("1.0"),"^"),C=$P(^DD(130,1.01,0),"^",2) D:Y'="" Y^DIQ  S SRANES=Y I Y["MONITORED ANES" S SRANES="MONITORED ANES CARE"
 | 
|---|
 | 20 |  K SRSLOC I $D(^DPT(DFN,.1)) S SRSLOC=$P(^(.1),"^") I $D(^DPT(DFN,.101)) S SRSLOC=SRSLOC_"  "_$P(^(.101),"^")
 | 
|---|
 | 21 |  I '$D(SRSLOC) S X=$P(^SRF(SRTN,0),"^",12),SRSLOC=$S(X="I":"TO BE ADMITTED",1:"OUTPATIENT")
 | 
|---|
 | 22 |  S (SRSUR,SRFST,SRATT,SRAN1,SRAN2)=""
 | 
|---|
 | 23 |  S SRSUR=$P(S(.1),"^",4),SRATT=$P(S(.1),"^",13),SRFST=$P(S(.1),"^",5),SRAN1=$P(S(.3),"^",4),SRAN2=$P(S(.3),"^") S:SRSUR'="" SRSUR=$P(^VA(200,SRSUR,0),"^") S:SRATT'="" SRATT=$P(^VA(200,SRATT,0),"^") S:SRFST'="" SRFST=$P(^VA(200,SRFST,0),"^")
 | 
|---|
 | 24 |  S:SRAN1'="" SRAN1=$P(^VA(200,SRAN1,0),"^") S:SRAN2'="" SRAN2=$P(^VA(200,SRAN2,0),"^")
 | 
|---|
 | 25 |  S SRDIAG=$S($D(^SRF(SRTN,33)):$P(^(33),"^"),1:"")
 | 
|---|
 | 26 | OPS S SROPER=$P(^SRF(SRTN,"OP"),"^"),OPER=0 F I=0:0 S OPER=$O(^SRF(SRTN,13,OPER)) Q:OPER=""  D OTHER
 | 
|---|
 | 27 |  K SROPS,MM,MMM S:$L(SROPER)<50 SROPS(1)=SROPER I $L(SROPER)>49 S SROPER=SROPER_"  " F M=1:1 D LOOP Q:MMM=""
 | 
|---|
 | 28 |  D TIME^SROSCH1
 | 
|---|
 | 29 |  F SRUSER="SRSUR","SRFST","SRATT","SRAN1","SRAN2" S:'$D(@SRUSER) @SRUSER="" I @SRUSER]"" S @SRUSER=$P(@SRUSER,",",1)_", "_$E($P(@SRUSER,",",2),1)
 | 
|---|
 | 30 |  S Y=$P($G(^SRF(SRTN,.4)),"^",3),C=$P(^DD(130,.43,0),"^",2) D:Y'="" Y^DIQ S SROPD=$E(Y,1,14)
 | 
|---|
 | 31 |  S X=$P($G(^SRF(SRTN,35)),"^",2),SRPREAD=$S(X="Y":" (P.A.T.)",1:"")
 | 
|---|
 | 32 | PRINT ; print variables
 | 
|---|
 | 33 |  D PRINT^SROSCH2
 | 
|---|
 | 34 |  Q
 | 
|---|
 | 35 | END ;
 | 
|---|
 | 36 |  W:$E(IOST)="P" @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP)  S ZTREQ="@" Q
 | 
|---|
 | 37 |  D ^SRSKILL K SRTN D ^%ZISC W @IOF
 | 
|---|
 | 38 |  Q
 | 
|---|
 | 39 | OTHER ; other operations
 | 
|---|
 | 40 |  S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,OPER,0),"^"))>250 S SRLONG=0,OPER=999,SROPERS=" ..."
 | 
|---|
 | 41 |  I SRLONG S SROPERS=$P(^SRF(SRTN,13,OPER,0),"^")
 | 
|---|
 | 42 |  S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)
 | 
|---|
 | 43 |  Q
 | 
|---|
 | 44 | LOOP ; break procedure if greater than 50 characters
 | 
|---|
 | 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)'<50  S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
 | 
|---|
 | 46 |  Q
 | 
|---|
 | 47 | BLOOD S SRBU=$P(^SRF(SRTN,11,SRB,0),"^",2),SRB(SRB)=SRB(SRB)_" - "_SRBU_$S(SRBU>1:" UNITS",SRBU>0:" UNIT",1:" UNITS NOT ENTERED")
 | 
|---|
 | 48 |  S SRBX=$P(^SRF(SRTN,11,SRB,0),"^",3),SRBX=$S(SRBX="S":"SCREEN",SRBX="C":"CROSSMATCH",SRBX="A":"AUTOLOGOUS",1:"") I SRBX'="" S SRB(SRB)=SRB(SRB)_" ("_SRBX_")"
 | 
|---|
 | 49 |  Q
 | 
|---|