SROAOPS ;BIR/MAM - OTHER PROCEDURES ; 17 MAR 1992 1:30 pm [ 12/15/98 12:51 PM ]
;;3.0; Surgery ;**88**;24 Jun 93
OTHER ; other procedures
I '$D(^SRF(SRTN,13,0)) S ^SRF(SRTN,13,0)="^130.16A^0^0"
K SRAOTH F I=1:1:5 S SRAOTH(I)=""
S (OPS,CNT)=0 F S OPS=$O(^SRF(SRTN,13,OPS)) Q:'OPS D SETOP
D HDR
W !,"1. Other Procedure (1):" I $D(SRAOTH(1)) W ?25,$P(SRAOTH(1),"^")
W !," CPT Code:" I $D(SRAOTH("1A")) W ?25,$P(SRAOTH("1A"),"^")
W !!,"2. Other Procedure (2):" I $D(SRAOTH(2)) W ?25,$P(SRAOTH(2),"^")
W !," CPT Code:" I $D(SRAOTH("2A")) W ?25,$P(SRAOTH("2A"),"^")
W !!,"3. Other Procedure (3):" I $D(SRAOTH(3)) W ?25,$P(SRAOTH(3),"^")
W !," CPT Code:" I $D(SRAOTH("3A")) W ?25,$P(SRAOTH("3A"),"^")
W !!,"4. Other Procedure (4):" I $D(SRAOTH(4)) W ?25,$P(SRAOTH(4),"^")
W !," CPT Code:" I $D(SRAOTH("4A")) W ?25,$P(SRAOTH("4A"),"^")
W !!,"5. Other Procedure (5):" I $D(SRAOTH(5)) W ?25,$P(SRAOTH(5),"^")
W !," CPT Code:" I $D(SRAOTH("5A")) W ?25,$P(SRAOTH("5A"),"^")
W ! F MOE=1:1:80 W "-"
ASK W !!,"Select Other Operative Procedure Information: " R X:DTIME I '$T!("^"[X) Q
I X'="A",'$D(SRAOTH(X)) D HELP G:SRSOUT END G OTHER
S:X="A" X="1:5" I X?.N1":".N S Y=$P(X,":"),Z=$P(X,":",2) I Y<1!(Z>5)!(Y>Z) D HELP G:SRSOUT END G OTHER
D HDR I X?.N1":".N D RANGE,HDR G OTHER
S KAREN=X D ONE G OTHER
Q
END K SRAOTH,CNT
Q
HELP W @IOF,!!!!!,"Enter the number or range of numbers you want to edit. Examples of proper",!,"responses are listed below."
W !!,"1. Enter 'A' to update all information.",!!,"2. Enter a number (1-5) to update one specific procedure. For example, ",!," enter '1' to update Other Procedure (1)."
W !!,"3. Enter a range of numbers, separated by a ':' to update more than one",!," procedure. For example, enter '1:2' to enter Other Procedure (1) and",!," Other Procedure (2)."
W !!,"Press <RET> to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1
Q
SETOP ; set other operative info
S OTHER=^SRF(SRTN,13,OPS,0),CNT=CNT+1,SRAOTH(CNT)=$P(OTHER,"^")_"^"_OPS,X=$P(OTHER,"^",2) S:X X=$P($$CPT^ICPTCOD(X),"^",2) S Y=CNT_"A",SRAOTH(Y)=X_"^"_OPS
Q
RANGE ; range of numbers
S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) F KAREN=SHEMP:1:CURLEY Q:SRSOUT D ONE
Q
ONE ; edit one procedure
W !! I SRAOTH(KAREN)'="" K DR,DIE S DA=$P(SRAOTH(KAREN),"^",2),DIE="^SRF("_SRTN_",11,",DA(1)=SRTN,DR=".01T;1T" D ^DIE K DR Q
K DIR,DA S DIR(0)="130.16,.01",DIR("A")="Other Operative Procedure ("_KAREN_")" D ^DIR I Y="" Q
K DA,DIC,DD,DO,DINUM S DA(1)=SRTN,X=Y,DIC="^SRF("_SRTN_",13,",DIC(0)="L" D FILE^DICN K DIC,DD,DO
K DR,DIE S DA=+Y,DA(1)=SRTN,DR="1T",DIE="^SRF("_SRTN_",13," D ^DIE K DR
Q
HDR W @IOF,!,SRANAME,! F MOE=1:1:80 W "-"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAOPS 2727 printed Nov 22, 2024@17:51:21 Page 2
SROAOPS ;BIR/MAM - OTHER PROCEDURES ; 17 MAR 1992 1:30 pm [ 12/15/98 12:51 PM ]
+1 ;;3.0; Surgery ;**88**;24 Jun 93
OTHER ; other procedures
+1 IF '$DATA(^SRF(SRTN,13,0))
SET ^SRF(SRTN,13,0)="^130.16A^0^0"
+2 KILL SRAOTH
FOR I=1:1:5
SET SRAOTH(I)=""
+3 SET (OPS,CNT)=0
FOR
SET OPS=$ORDER(^SRF(SRTN,13,OPS))
if 'OPS
QUIT
DO SETOP
+4 DO HDR
+5 WRITE !,"1. Other Procedure (1):"
IF $DATA(SRAOTH(1))
WRITE ?25,$PIECE(SRAOTH(1),"^")
+6 WRITE !," CPT Code:"
IF $DATA(SRAOTH("1A"))
WRITE ?25,$PIECE(SRAOTH("1A"),"^")
+7 WRITE !!,"2. Other Procedure (2):"
IF $DATA(SRAOTH(2))
WRITE ?25,$PIECE(SRAOTH(2),"^")
+8 WRITE !," CPT Code:"
IF $DATA(SRAOTH("2A"))
WRITE ?25,$PIECE(SRAOTH("2A"),"^")
+9 WRITE !!,"3. Other Procedure (3):"
IF $DATA(SRAOTH(3))
WRITE ?25,$PIECE(SRAOTH(3),"^")
+10 WRITE !," CPT Code:"
IF $DATA(SRAOTH("3A"))
WRITE ?25,$PIECE(SRAOTH("3A"),"^")
+11 WRITE !!,"4. Other Procedure (4):"
IF $DATA(SRAOTH(4))
WRITE ?25,$PIECE(SRAOTH(4),"^")
+12 WRITE !," CPT Code:"
IF $DATA(SRAOTH("4A"))
WRITE ?25,$PIECE(SRAOTH("4A"),"^")
+13 WRITE !!,"5. Other Procedure (5):"
IF $DATA(SRAOTH(5))
WRITE ?25,$PIECE(SRAOTH(5),"^")
+14 WRITE !," CPT Code:"
IF $DATA(SRAOTH("5A"))
WRITE ?25,$PIECE(SRAOTH("5A"),"^")
+15 WRITE !
FOR MOE=1:1:80
WRITE "-"
ASK WRITE !!,"Select Other Operative Procedure Information: "
READ X:DTIME
IF '$TEST!("^"[X)
QUIT
+1 IF X'="A"
IF '$DATA(SRAOTH(X))
DO HELP
if SRSOUT
GOTO END
GOTO OTHER
+2 if X="A"
SET X="1:5"
IF X?.N1":".N
SET Y=$PIECE(X,":")
SET Z=$PIECE(X,":",2)
IF Y<1!(Z>5)!(Y>Z)
DO HELP
if SRSOUT
GOTO END
GOTO OTHER
+3 DO HDR
IF X?.N1":".N
DO RANGE
DO HDR
GOTO OTHER
+4 SET KAREN=X
DO ONE
GOTO OTHER
+5 QUIT
END KILL SRAOTH,CNT
+1 QUIT
HELP WRITE @IOF,!!!!!,"Enter the number or range of numbers you want to edit. Examples of proper",!,"responses are listed below."
+1 WRITE !!,"1. Enter 'A' to update all information.",!!,"2. Enter a number (1-5) to update one specific procedure. For example, ",!," enter '1' to update Other Procedure (1)."
+2 WRITE !!,"3. Enter a range of numbers, separated by a ':' to update more than one",!," procedure. For example, enter '1:2' to enter Other Procedure (1) and",!," Other Procedure (2)."
+3 WRITE !!,"Press <RET> to continue, or '^' to quit "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
+4 QUIT
SETOP ; set other operative info
+1 SET OTHER=^SRF(SRTN,13,OPS,0)
SET CNT=CNT+1
SET SRAOTH(CNT)=$PIECE(OTHER,"^")_"^"_OPS
SET X=$PIECE(OTHER,"^",2)
if X
SET X=$PIECE($$CPT^ICPTCOD(X),"^",2)
SET Y=CNT_"A"
SET SRAOTH(Y)=X_"^"_OPS
+2 QUIT
RANGE ; range of numbers
+1 SET SHEMP=$PIECE(X,":")
SET CURLEY=$PIECE(X,":",2)
FOR KAREN=SHEMP:1:CURLEY
if SRSOUT
QUIT
DO ONE
+2 QUIT
ONE ; edit one procedure
+1 WRITE !!
IF SRAOTH(KAREN)'=""
KILL DR,DIE
SET DA=$PIECE(SRAOTH(KAREN),"^",2)
SET DIE="^SRF("_SRTN_",11,"
SET DA(1)=SRTN
SET DR=".01T;1T"
DO ^DIE
KILL DR
QUIT
+2 KILL DIR,DA
SET DIR(0)="130.16,.01"
SET DIR("A")="Other Operative Procedure ("_KAREN_")"
DO ^DIR
IF Y=""
QUIT
+3 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 DIC,DD,DO
+4 KILL DR,DIE
SET DA=+Y
SET DA(1)=SRTN
SET DR="1T"
SET DIE="^SRF("_SRTN_",13,"
DO ^DIE
KILL DR
+5 QUIT
HDR WRITE @IOF,!,SRANAME,!
FOR MOE=1:1:80
WRITE "-"
+1 QUIT
