1 | SROAOPS ;BIR/MAM - OTHER PROCEDURES ; 17 MAR 1992 1:30 pm [ 12/15/98 12:51 PM ]
|
---|
2 | ;;3.0; Surgery ;**88**;24 Jun 93
|
---|
3 | OTHER ; other procedures
|
---|
4 | I '$D(^SRF(SRTN,13,0)) S ^SRF(SRTN,13,0)="^130.16A^0^0"
|
---|
5 | K SRAOTH F I=1:1:5 S SRAOTH(I)=""
|
---|
6 | S (OPS,CNT)=0 F S OPS=$O(^SRF(SRTN,13,OPS)) Q:'OPS D SETOP
|
---|
7 | D HDR
|
---|
8 | W !,"1. Other Procedure (1):" I $D(SRAOTH(1)) W ?25,$P(SRAOTH(1),"^")
|
---|
9 | W !," CPT Code:" I $D(SRAOTH("1A")) W ?25,$P(SRAOTH("1A"),"^")
|
---|
10 | W !!,"2. Other Procedure (2):" I $D(SRAOTH(2)) W ?25,$P(SRAOTH(2),"^")
|
---|
11 | W !," CPT Code:" I $D(SRAOTH("2A")) W ?25,$P(SRAOTH("2A"),"^")
|
---|
12 | W !!,"3. Other Procedure (3):" I $D(SRAOTH(3)) W ?25,$P(SRAOTH(3),"^")
|
---|
13 | W !," CPT Code:" I $D(SRAOTH("3A")) W ?25,$P(SRAOTH("3A"),"^")
|
---|
14 | W !!,"4. Other Procedure (4):" I $D(SRAOTH(4)) W ?25,$P(SRAOTH(4),"^")
|
---|
15 | W !," CPT Code:" I $D(SRAOTH("4A")) W ?25,$P(SRAOTH("4A"),"^")
|
---|
16 | W !!,"5. Other Procedure (5):" I $D(SRAOTH(5)) W ?25,$P(SRAOTH(5),"^")
|
---|
17 | W !," CPT Code:" I $D(SRAOTH("5A")) W ?25,$P(SRAOTH("5A"),"^")
|
---|
18 | W ! F MOE=1:1:80 W "-"
|
---|
19 | ASK W !!,"Select Other Operative Procedure Information: " R X:DTIME I '$T!("^"[X) Q
|
---|
20 | I X'="A",'$D(SRAOTH(X)) D HELP G:SRSOUT END G OTHER
|
---|
21 | 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
|
---|
22 | D HDR I X?.N1":".N D RANGE,HDR G OTHER
|
---|
23 | S KAREN=X D ONE G OTHER
|
---|
24 | Q
|
---|
25 | END K SRAOTH,CNT
|
---|
26 | Q
|
---|
27 | HELP W @IOF,!!!!!,"Enter the number or range of numbers you want to edit. Examples of proper",!,"responses are listed below."
|
---|
28 | 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)."
|
---|
29 | 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)."
|
---|
30 | W !!,"Press <RET> to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1
|
---|
31 | Q
|
---|
32 | SETOP ; set other operative info
|
---|
33 | 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
|
---|
34 | Q
|
---|
35 | RANGE ; range of numbers
|
---|
36 | S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) F KAREN=SHEMP:1:CURLEY Q:SRSOUT D ONE
|
---|
37 | Q
|
---|
38 | ONE ; edit one procedure
|
---|
39 | 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
|
---|
40 | K DIR,DA S DIR(0)="130.16,.01",DIR("A")="Other Operative Procedure ("_KAREN_")" D ^DIR I Y="" Q
|
---|
41 | 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
|
---|
42 | K DR,DIE S DA=+Y,DA(1)=SRTN,DR="1T",DIE="^SRF("_SRTN_",13," D ^DIE K DR
|
---|
43 | Q
|
---|
44 | HDR W @IOF,!,SRANAME,! F MOE=1:1:80 W "-"
|
---|
45 | Q
|
---|