SROREST ;B'HAM ISC/MAM - STUFF RESTRAINTS; [ 01/30/01 1:13 AM ]
;;3.0; Surgery ;**94,100**;24 Jun 93
N SRLCK S SRSOUT=0 I '$D(SRTN) W !!,"A surgical case has not been entered. " G END
D ^SROLOCK I SROLOCK S SRSOUT=1 G END
ASK W @IOF,!,"Enter/Edit Irrigations or Restraints and Positioning Aids:",!!,"1. Irrigations",!,"2. Restraints and Positioning Aids",!!,"Select Number: " R X:DTIME I '$T!("^^"[X) S SRSOUT=1 G END
I X'=1&(X'=2) S X="?"
I X["?" W !!,"Type '1' to enter irrigation solutions, or '2' to enter restraints",!,"or positioning aids.",!!,"Press RETURN to continue " R X:DTIME G ASK
S SRLCK=$$LOCK^SROUTL(SRTN) I '$G(SRLCK) G ASK
I X=1 G ^SROIRR
LIST ;
K SREST S (CNT,SREST)=0 F S SREST=$O(^SRO(132.05,SREST)) Q:'SREST S INACT=$P(^SRO(132.05,SREST,0),"^",2) I 'INACT S CNT=CNT+1,SREST(CNT)=SREST_"^"_$P(^SRO(132.05,SREST,0),"^")
N SRD,SRI,SRFIRST,SRJ,SRLAST,SRP,SRP1,SRQ,SRTOT S SRD=36,SRTOT=CNT,SRP1=CNT/SRD,SRP=$P(SRP1,".") I SRP1>SRP S SRP=SRP+1
S (CNT,SRLAST)=0 F SRPAGE=1:1:SRP S SRNUM=$S(SRTOT>SRD:"Page "_SRPAGE_" of "_SRP,1:""),SRFIRST=SRLAST+1,SRLAST=$S(SRLAST+SRD<SRTOT:SRLAST+SRD,1:SRTOT) D PAGE Q:SRSOUT
END D ^SRSKILL D:$G(SRLCK) UNLOCK^SROUTL(SRTN) W @IOF
Q
PAGE Q:SRSOUT W @IOF,!,?20,"Restraints and Positioning Aids",?(79-$L(SRNUM)),SRNUM,! F I=1:1:80 W "="
F CNT=SRFIRST:1:SRLAST S S=SREST(CNT) W:CNT#2 !,$J(CNT,2)_". "_$P(SREST(CNT),"^",2) W:'(CNT#2) ?40,$J(CNT,2)_". "_$P(SREST(CNT),"^",2)
W ! F LINE=1:1:80 W "-"
SEL W ! K DIR S DIR("?",1)=" Enter the numbers corresponding to your choices, separated by a comma (,).",DIR("?")=" For example, if selecting items 1, 4 and 7, you would enter '1,4,7'."
S DIR("A")="Select the number(s) corresponding to your choice: ",DIR(0)="FAO" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
S SRX=Y I Y="" Q
S:'$D(^SRF(SRTN,20,0)) ^SRF(SRTN,20,0)="^130.31PA^0^0"
S SRQ=0 F SRCNT=1:1 S SRI=$P(SRX,",",SRCNT) Q:SRI=""!SRQ I '$D(SREST(SRI)) W !!,SRI_" is an invalid entry. Please try again." S SRQ=1
I SRQ D RET S:$D(DTOUT)!$D(DUOUT) SRSOUT=1 G PAGE
F SRCNT=1:1 S SRI=$P(SRX,",",SRCNT) Q:SRI="" D STUFF
D RET I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
Q
STUFF ; stuff restraints in Surgery file
I $D(SREST(SRI)) S SREST=+SREST(SRI),SREST1=$P(SREST(SRI),"^",2) W !!,"Entering "_SREST1_" ..." K DR S DIE=130,DA=SRTN,DR=".13///"_SREST1,DR(2,130.31)=.01 D ^DIE K DR
Q
RET W ! K DIR S DIR(0)="FOA",DIR("A")="Press RETURN to continue " D ^DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROREST 2457 printed Oct 16, 2024@18:46:28 Page 2
SROREST ;B'HAM ISC/MAM - STUFF RESTRAINTS; [ 01/30/01 1:13 AM ]
+1 ;;3.0; Surgery ;**94,100**;24 Jun 93
+2 NEW SRLCK
SET SRSOUT=0
IF '$DATA(SRTN)
WRITE !!,"A surgical case has not been entered. "
GOTO END
+3 DO ^SROLOCK
IF SROLOCK
SET SRSOUT=1
GOTO END
ASK WRITE @IOF,!,"Enter/Edit Irrigations or Restraints and Positioning Aids:",!!,"1. Irrigations",!,"2. Restraints and Positioning Aids",!!,"Select Number: "
READ X:DTIME
IF '$TEST!("^^"[X)
SET SRSOUT=1
GOTO END
+1 IF X'=1&(X'=2)
SET X="?"
+2 IF X["?"
WRITE !!,"Type '1' to enter irrigation solutions, or '2' to enter restraints",!,"or positioning aids.",!!,"Press RETURN to continue "
READ X:DTIME
GOTO ASK
+3 SET SRLCK=$$LOCK^SROUTL(SRTN)
IF '$GET(SRLCK)
GOTO ASK
+4 IF X=1
GOTO ^SROIRR
LIST ;
+1 KILL SREST
SET (CNT,SREST)=0
FOR
SET SREST=$ORDER(^SRO(132.05,SREST))
if 'SREST
QUIT
SET INACT=$PIECE(^SRO(132.05,SREST,0),"^",2)
IF 'INACT
SET CNT=CNT+1
SET SREST(CNT)=SREST_"^"_$PIECE(^SRO(132.05,SREST,0),"^")
+2 NEW SRD,SRI,SRFIRST,SRJ,SRLAST,SRP,SRP1,SRQ,SRTOT
SET SRD=36
SET SRTOT=CNT
SET SRP1=CNT/SRD
SET SRP=$PIECE(SRP1,".")
IF SRP1>SRP
SET SRP=SRP+1
+3 SET (CNT,SRLAST)=0
FOR SRPAGE=1:1:SRP
SET SRNUM=$SELECT(SRTOT>SRD:"Page "_SRPAGE_" of "_SRP,1:"")
SET SRFIRST=SRLAST+1
SET SRLAST=$SELECT(SRLAST+SRD<SRTOT:SRLAST+SRD,1:SRTOT)
DO PAGE
if SRSOUT
QUIT
END DO ^SRSKILL
if $GET(SRLCK)
DO UNLOCK^SROUTL(SRTN)
WRITE @IOF
+1 QUIT
PAGE if SRSOUT
QUIT
WRITE @IOF,!,?20,"Restraints and Positioning Aids",?(79-$LENGTH(SRNUM)),SRNUM,!
FOR I=1:1:80
WRITE "="
+1 FOR CNT=SRFIRST:1:SRLAST
SET S=SREST(CNT)
if CNT#2
WRITE !,$JUSTIFY(CNT,2)_". "_$PIECE(SREST(CNT),"^",2)
if '(CNT#2)
WRITE ?40,$JUSTIFY(CNT,2)_". "_$PIECE(SREST(CNT),"^",2)
+2 WRITE !
FOR LINE=1:1:80
WRITE "-"
SEL WRITE !
KILL DIR
SET DIR("?",1)=" Enter the numbers corresponding to your choices, separated by a comma (,)."
SET DIR("?")=" For example, if selecting items 1, 4 and 7, you would enter '1,4,7'."
+1 SET DIR("A")="Select the number(s) corresponding to your choice: "
SET DIR(0)="FAO"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+2 SET SRX=Y
IF Y=""
QUIT
+3 if '$DATA(^SRF(SRTN,20,0))
SET ^SRF(SRTN,20,0)="^130.31PA^0^0"
+4 SET SRQ=0
FOR SRCNT=1:1
SET SRI=$PIECE(SRX,",",SRCNT)
if SRI=""!SRQ
QUIT
IF '$DATA(SREST(SRI))
WRITE !!,SRI_" is an invalid entry. Please try again."
SET SRQ=1
+5 IF SRQ
DO RET
if $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
GOTO PAGE
+6 FOR SRCNT=1:1
SET SRI=$PIECE(SRX,",",SRCNT)
if SRI=""
QUIT
DO STUFF
+7 DO RET
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
+8 QUIT
STUFF ; stuff restraints in Surgery file
+1 IF $DATA(SREST(SRI))
SET SREST=+SREST(SRI)
SET SREST1=$PIECE(SREST(SRI),"^",2)
WRITE !!,"Entering "_SREST1_" ..."
KILL DR
SET DIE=130
SET DA=SRTN
SET DR=".13///"_SREST1
SET DR(2,130.31)=.01
DO ^DIE
KILL DR
+2 QUIT
RET WRITE !
KILL DIR
SET DIR(0)="FOA"
SET DIR("A")="Press RETURN to continue "
DO ^DIR
+1 QUIT
