- 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
- 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
