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