- SROTHER ;BIR/MAM - OTHER PROCEDURES ;05/14/99 12:14 PM
- ;;3.0; Surgery ;**38,88,142**;24 Jun 93
- S SRSOUT=0 I '$D(SRTN) W @IOF,!!,"A surgical case must be selected prior to using this option.",!!,"Press RETURN to continue " R X:DTIME S SRSOUT=1 G END
- D ^SROAUTL S SR(0)=^SRF(SRTN,0),Y=$P(SR(0),"^",9),SRDATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3),SRLINE="" F I=0:1:79 S SRLINE=SRLINE_"-"
- START D HDR K SROTHER S (OTH,CNT)=0 F S OTH=$O(^SRF(SRTN,13,OTH)) Q:'OTH!($D(SROTHER)) Q:SRSOUT S CNT=CNT+1 D LIST I CNT=13 W !!,SRLINE D SEL
- I SRSOUT Q
- I $D(SROTHER) D EDIT G START
- I CNT W !!,SRLINE
- I CNT=0 D ASK G:'SRSOUT START S SRSOUT=0 Q
- OPT W !!,"Enter "_$S(CNT=1:1,1:"(1-"_CNT_")")_" to edit an existing procedure, or 'NEW' to",!,"enter another operative procedure: " R X:DTIME I '$T!("^"[X) Q
- I $E(X)="N" D NEW G START
- I '$D(OTHER(X)) W !!,"Select the number corresponding to the procedure you want to edit, or 'NEW' to",!,"enter an additional operative procedure." G OPT
- S SROTHER=$P(OTHER(X),"^",3) D EDIT G START
- Q
- END I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
- D ^SRSKILL W @IOF
- Q
- LIST ; list existing procedures
- S X=^SRF(SRTN,13,OTH,0),CPT=$P($G(^SRF(SRTN,13,OTH,2)),"^") I CPT S Y=$P($$CPT^ICPTCOD(CPT),"^",2),SRDA=OTH D SSOTH^SROCPT S CPT=Y
- I CPT="" S CPT="NOT ENTERED"
- S OTHER(CNT)=$P(X,"^")_"^"_CPT_"^"_OTH
- W !,$S(CNT<10:" ",1:"")_CNT_". "_$P(OTHER(CNT),"^")_$S('$D(SRSUPCPT):" (CPT: "_$P(OTHER(CNT),"^",2)_")",1:"")
- Q
- SEL ; select procedure
- W !!,"Select (1-"_CNT_") to edit an existing procedure, or RETURN to continue: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
- I X="" S CNT=0 K OTHER D HDR Q
- I '$D(OTHER(X)) W !!,"Enter the number corresponding to the procedure you want to edit, or RETURN",!,"to continue listing procedures." G SEL
- S SROTHER=$P(OTHER(X),"^",3)
- Q
- HDR ; print screen header
- S SRPAGE="OTHER OPERATIVE PROCEDURES" D HDR^SROAUTL
- Q
- EDIT ; edit one procedure
- D HDR W ! S DA=SROTHER,DIE="^SRF("_SRTN_",13,",DA(1)=SRTN,DR=".01T"_$S('$D(SRSUPCPT):";3T",1:"")
- D ^DIE K DR,DIE
- Q
- ASK W !!,"There are no additional procedures entered for this case. Do you want to add",!,"a new procedure ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRYN="N"
- S:SRYN="" SRYN="Y"
- S SRYN=$E(SRYN) I "YyNn"'[SRYN W !!,"Enter 'YES' to add another operative procedure, or 'NO' to return to the",!,"previous screen." G ASK
- I "Nn"[SRYN S SRSOUT=1 Q
- NEW D HDR W ! K DIR,DA S DIR(0)="130.16,.01",DIR("A")="Other Operative Procedure" D ^DIR I Y=""!$D(DTOUT)!$D(DUOUT) Q
- I '$D(^SRF(SRTN,13,0)) S ^SRF(SRTN,13,0)="^130.16A^^"
- K DA,DIC,DD,DO,DINUM S DA(1)=SRTN,X=Y,DIC="^SRF("_SRTN_",13,",DIC(0)="L" D FILE^DICN K DA,DIC,DD,DO,DINUM
- I '$D(SRSUPCPT) K DR,DIE S DA=+Y,DA(1)=SRTN,DR="3T",DIE="^SRF("_SRTN_",13," D ^DIE K DR
- Q
- SROTHER ;BIR/MAM - OTHER PROCEDURES ;05/14/99 12:14 PM
- +1 ;;3.0; Surgery ;**38,88,142**;24 Jun 93
- +2 SET SRSOUT=0
- IF '$DATA(SRTN)
- WRITE @IOF,!!,"A surgical case must be selected prior to using this option.",!!,"Press RETURN to continue "
- READ X:DTIME
- SET SRSOUT=1
- GOTO END
- +3 DO ^SROAUTL
- SET SR(0)=^SRF(SRTN,0)
- SET Y=$PIECE(SR(0),"^",9)
- SET SRDATE=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
- SET SRLINE=""
- FOR I=0:1:79
- SET SRLINE=SRLINE_"-"
- START DO HDR
- KILL SROTHER
- SET (OTH,CNT)=0
- FOR
- SET OTH=$ORDER(^SRF(SRTN,13,OTH))
- IF 'OTH!($DATA(SROTHER))
- QUIT
- IF SRSOUT
- QUIT
- SET CNT=CNT+1
- DO LIST
- IF CNT=13
- WRITE !!,SRLINE
- DO SEL
- +1 IF SRSOUT
- QUIT
- +2 IF $DATA(SROTHER)
- DO EDIT
- GOTO START
- +3 IF CNT
- WRITE !!,SRLINE
- +4 IF CNT=0
- DO ASK
- IF 'SRSOUT
- GOTO START
- SET SRSOUT=0
- QUIT
- OPT WRITE !!,"Enter "_$SELECT(CNT=1:1,1:"(1-"_CNT_")")_" to edit an existing procedure, or 'NEW' to",!,"enter another operative procedure: "
- READ X:DTIME
- IF '$TEST!("^"[X)
- QUIT
- +1 IF $EXTRACT(X)="N"
- DO NEW
- GOTO START
- +2 IF '$DATA(OTHER(X))
- WRITE !!,"Select the number corresponding to the procedure you want to edit, or 'NEW' to",!,"enter an additional operative procedure."
- GOTO OPT
- +3 SET SROTHER=$PIECE(OTHER(X),"^",3)
- DO EDIT
- GOTO START
- +4 QUIT
- END IF 'SRSOUT
- WRITE !!,"Press RETURN to continue "
- READ X:DTIME
- +1 DO ^SRSKILL
- WRITE @IOF
- +2 QUIT
- LIST ; list existing procedures
- +1 SET X=^SRF(SRTN,13,OTH,0)
- SET CPT=$PIECE($GET(^SRF(SRTN,13,OTH,2)),"^")
- IF CPT
- SET Y=$PIECE($$CPT^ICPTCOD(CPT),"^",2)
- SET SRDA=OTH
- DO SSOTH^SROCPT
- SET CPT=Y
- +2 IF CPT=""
- SET CPT="NOT ENTERED"
- +3 SET OTHER(CNT)=$PIECE(X,"^")_"^"_CPT_"^"_OTH
- +4 WRITE !,$SELECT(CNT<10:" ",1:"")_CNT_". "_$PIECE(OTHER(CNT),"^")_$SELECT('$DATA(SRSUPCPT):" (CPT: "_$PIECE(OTHER(CNT),"^",2)_")",1:"")
- +5 QUIT
- SEL ; select procedure
- +1 WRITE !!,"Select (1-"_CNT_") to edit an existing procedure, or RETURN to continue: "
- READ X:DTIME
- IF '$TEST!(X["^")
- SET SRSOUT=1
- QUIT
- +2 IF X=""
- SET CNT=0
- KILL OTHER
- DO HDR
- QUIT
- +3 IF '$DATA(OTHER(X))
- WRITE !!,"Enter the number corresponding to the procedure you want to edit, or RETURN",!,"to continue listing procedures."
- GOTO SEL
- +4 SET SROTHER=$PIECE(OTHER(X),"^",3)
- +5 QUIT
- HDR ; print screen header
- +1 SET SRPAGE="OTHER OPERATIVE PROCEDURES"
- DO HDR^SROAUTL
- +2 QUIT
- EDIT ; edit one procedure
- +1 DO HDR
- WRITE !
- SET DA=SROTHER
- SET DIE="^SRF("_SRTN_",13,"
- SET DA(1)=SRTN
- SET DR=".01T"_$SELECT('$DATA(SRSUPCPT):";3T",1:"")
- +2 DO ^DIE
- KILL DR,DIE
- +3 QUIT
- ASK WRITE !!,"There are no additional procedures entered for this case. Do you want to add",!,"a new procedure ? YES// "
- READ SRYN:DTIME
- IF '$TEST!(SRYN["^")
- SET SRYN="N"
- +1 IF SRYN=""
- SET SRYN="Y"
- +2 SET SRYN=$EXTRACT(SRYN)
- IF "YyNn"'[SRYN
- WRITE !!,"Enter 'YES' to add another operative procedure, or 'NO' to return to the",!,"previous screen."
- GOTO ASK
- +3 IF "Nn"[SRYN
- SET SRSOUT=1
- QUIT
- NEW DO HDR
- WRITE !
- KILL DIR,DA
- SET DIR(0)="130.16,.01"
- SET DIR("A")="Other Operative Procedure"
- DO ^DIR
- IF Y=""!$DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +1 IF '$DATA(^SRF(SRTN,13,0))
- SET ^SRF(SRTN,13,0)="^130.16A^^"
- +2 KILL DA,DIC,DD,DO,DINUM
- SET DA(1)=SRTN
- SET X=Y
- SET DIC="^SRF("_SRTN_",13,"
- SET DIC(0)="L"
- DO FILE^DICN
- KILL DA,DIC,DD,DO,DINUM
- +3 IF '$DATA(SRSUPCPT)
- KILL DR,DIE
- SET DA=+Y
- SET DA(1)=SRTN
- SET DR="3T"
- SET DIE="^SRF("_SRTN_",13,"
- DO ^DIE
- KILL DR
- +4 QUIT
