Changeset 623 for WorldVistAEHR/trunk/r/SURGERY-SR/SROAOP.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SURGERY-SR/SROAOP.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SURGERY-SR/SROAOP.m
r613 r623 1 SROAOP ;BIR/MAM - ENTER OPERATION INFO ;11/27/07 2 ;;3.0; Surgery ;**19,38,47,63,67,81,86,97,100,125,142,153,160,166**;24 Jun 93;Build 7 3 I '$D(SRTN) W !!,"A Surgery Risk Assessment must be selected prior to using this option.",!!,"Press <RET> to continue " R X:DTIME G END 4 S SRSOUT=0,SRSUPCPT=1 D ^SROAUTL 5 START G:SRSOUT END K SRAOTH,SRACON D ^SROAOP1 6 ASK W !!,"Select Operative Information to Edit: " R SRASEL:DTIME I '$T!(SRASEL["^") S SRSOUT=1 G END 7 I SRASEL="" G END 8 S SRN=13 S:SRASEL="a" SRASEL="A" I '$D(SRAO(SRASEL)),(SRASEL'?.N1":".N),(SRASEL'="A") D HELP G:SRSOUT END G START 9 I SRASEL="A" S SRASEL="1:"_SRN 10 I SRASEL?.N1":".N S Y=$E(SRASEL),Z=$P(SRASEL,":",2) I Y<1!(Z>SRN)!(Y>Z) D HELP G:SRSOUT END G START 11 S MM=$E(SRASEL) I MM'=3,(MM'=4),(MM'=5) S SRHDR(.5)=SRDOC D HDR^SROAUTL 12 I SRASEL?.N1":".N D RANGE G START 13 Q:'$D(SRAO(SRASEL)) 14 S EMILY=SRASEL D G START 15 .I $$LOCK^SROUTL(SRTN) D ONE,UNLOCK^SROUTL(SRTN) 16 END I $D(SRSOUT),'SRSOUT D ^SROAOP2 17 I $D(SRTN) S SROERR=SRTN D ^SROERR0 18 W @IOF D ^SRSKILL 19 Q 20 HELP W @IOF,!!!!,"Enter the number or range of numbers you want to edit. Examples of proper" 21 W !,"responses are listed below.",!!,"1. Enter 'A' to update all information." 22 W !!,"2. Enter a number (1-"_SRN_") to update the information in that field. (For" 23 W !," example, enter '2' to update Principal Operation.)" 24 W !!,"3. Enter a range of numbers (1-"_SRN_") separated by a ':' to enter a range of" 25 W !," information. (For example, enter '6:8' to update PGY of Primary Surgeon," 26 W !," Surgical Priority and Wound Classification.)",! 27 PRESS K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 28 Q 29 RANGE ; range of numbers 30 I $$LOCK^SROUTL(SRTN) D D UNLOCK^SROUTL(SRTN) 31 .S SHEMP=$P(SRASEL,":"),CURLEY=$P(SRASEL,":",2) F EMILY=SHEMP:1:CURLEY Q:SRSOUT D ONE 32 Q 33 ONE ; edit one item 34 I EMILY=3 D DISP^SROAUTL0 Q 35 I EMILY=10 D ANES Q 36 I EMILY=4 D ^SROTHER Q 37 I EMILY=5 D CONCUR Q 38 I EMILY=6,SRASEL[":",($P(SRASEL,":")'=6) S SRPAGE="" S SRHDR(.5)=SRDOC D HDR^SROAUTL 39 K DR,DIE S DA=SRTN,DR=$P(SRAO(EMILY),"^",2)_"T",DIE=130 D ^DIE K DR I $D(Y) S SRSOUT=1 40 I EMILY=2 D ^SROAUTL 41 Q 42 RET Q:SRSOUT W !!,"Press ENTER to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q 43 Q 44 CONCUR ; concurrent case information 45 N SRPROC,SRCSTAT S SRLINE="" F I=1:1:80 S SRLINE=SRLINE_"-" 46 S CON=$P($G(^SRF(SRTN,"CON")),"^") I CON,($P($G(^SRF(CON,30)),"^")!($P($G(^SRF(CON,31)),"^",8))) S CON="" 47 S SRPAGE="" D HDR^SROAUTL 48 W !,"Concurrent case information cannot be updated using the Risk Assessment" 49 W !,"Module. To update the CPT code of a concurrent case, please use an option" 50 W !,"contained within the CPT/ICD9 Coding Menu." 51 I CON D CC W !!,"Concurrent Procedure: ",?22,SROPS(1) I $D(SROPS(2)) W !,?22,SROPS(2) I $D(SROPS(3)) W !,?22,SROPS(3) I $D(SROPS(4)) W !,?22,SROPS(4) 52 I $D(SRCSTAT) W !!,?22,SRCSTAT 53 W !!,"Press ENTER to continue " R X:DTIME 54 Q 55 CC ; list concurrent procedure 56 N SRTN,SRL,SRZ S SRCSTAT=">> Coding "_$S($P($G(^SRO(136,CON,10)),"^"):"",1:"Not ")_"Complete <<" 57 S SRL=55,SRTN=CON D CPTS^SROAUTL0 58 I SRPROC(1)="NOT ENTERED"!'$D(SRPROC(1)) S SRPROC(1)="CPT NOT ENTERED" K SRCSTAT 59 S SROPER=$P(^SRF(CON,"OP"),"^")_" (" F I=1:1 Q:'$D(SRPROC(I)) S SROPER=SROPER_SRPROC(I) 60 S SROPER=SROPER_")" 61 K SROPS,MM,MMM S:$L(SROPER)<57 SROPS(1)=SROPER 62 I $L(SROPER)>56 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM="" 63 Q 64 LOOP ; break procedures 65 S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<57 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM 66 Q 67 ANES N SRANE,SRNEW 68 I $P(SRAO(10),"^")="NOT ENTERED",'$O(^SRF(SRTN,6,0)) D Q 69 .K DIR S DIR("A")="Select ANESTHESIA TECHNIQUE: ",DIR(0)="130.06,.01OA" D ^DIR K DIR S SRANE=Y I $D(DTOUT)!$D(DUOUT)!(Y="") Q 70 .K DD,DO S DIC="^SRF(SRTN,6,",X=SRANE,DIC(0)="L" D FILE^DICN K DIC,DD,DO I '+Y Q 71 .S SRNEW=+Y 72 .K DA,DIE,DR S DA=SRNEW,DA(1)=SRTN,DIE="^SRF(SRTN,6,",DR=".05T;42T" D ^DIE 73 K DR,DIE,DA S DA=SRTN,DR=".37T",DR(2,130.06)=".01T;.05T;42T",DIE=130 D ^DIE K DR 74 Q 1 SROAOP ;BIR/MAM - ENTER OPERATION INFO ;04/24/07 2 ;;3.0; Surgery ;**19,38,47,63,67,81,86,97,100,125,142,153,160**;24 Jun 93;Build 7 3 I '$D(SRTN) W !!,"A Surgery Risk Assessment must be selected prior to using this option.",!!,"Press <RET> to continue " R X:DTIME G END 4 S SRSOUT=0,SRSUPCPT=1 D ^SROAUTL 5 START G:SRSOUT END K SRAOTH,SRACON D ^SROAOP1 6 ASK W !!,"Select Operative Information to Edit: " R SRASEL:DTIME I '$T!(SRASEL["^") S SRSOUT=1 G END 7 I SRASEL="" G END 8 S SRN=13 S:SRASEL="a" SRASEL="A" I '$D(SRAO(SRASEL)),(SRASEL'?.N1":".N),(SRASEL'="A") D HELP G:SRSOUT END G START 9 I SRASEL="A" S SRASEL="1:"_SRN 10 I SRASEL?.N1":".N S Y=$E(SRASEL),Z=$P(SRASEL,":",2) I Y<1!(Z>SRN)!(Y>Z) D HELP G:SRSOUT END G START 11 S MM=$E(SRASEL) I MM'=3,(MM'=4),(MM'=5) S SRHDR(.5)=SRDOC D HDR^SROAUTL 12 I SRASEL?.N1":".N D RANGE G START 13 Q:'$D(SRAO(SRASEL)) 14 S EMILY=SRASEL D G START 15 .I $$LOCK^SROUTL(SRTN) D ONE,UNLOCK^SROUTL(SRTN) 16 END I $D(SRSOUT),'SRSOUT D ^SROAOP2 17 I $D(SRTN) S SROERR=SRTN D ^SROERR0 18 W @IOF D ^SRSKILL 19 Q 20 HELP W @IOF,!!!!,"Enter the number or range of numbers you want to edit. Examples of proper" 21 W !,"responses are listed below.",!!,"1. Enter 'A' to update all information." 22 W !!,"2. Enter a number (1-"_SRN_") to update the information in that field. (For" 23 W !," example, enter '2' to update Principal Operation.)" 24 W !!,"3. Enter a range of numbers (1-"_SRN_") separated by a ':' to enter a range of" 25 W !," information. (For example, enter '6:8' to update PGY of Primary Surgeon," 26 W !," Surgical Priority and Wound Classification.)",! 27 PRESS K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 28 Q 29 RANGE ; range of numbers 30 I $$LOCK^SROUTL(SRTN) D D UNLOCK^SROUTL(SRTN) 31 .S SHEMP=$P(SRASEL,":"),CURLEY=$P(SRASEL,":",2) F EMILY=SHEMP:1:CURLEY Q:SRSOUT D ONE 32 Q 33 ONE ; edit one item 34 I EMILY=3 D DISP^SROAUTL0 Q 35 I EMILY=10 D ANES Q 36 I EMILY=4 D ^SROTHER Q 37 I EMILY=5 D CONCUR Q 38 I EMILY=6,SRASEL[":",($P(SRASEL,":")'=6) S SRPAGE="" S SRHDR(.5)=SRDOC D HDR^SROAUTL 39 K DR,DIE S DA=SRTN,DR=$P(SRAO(EMILY),"^",2)_"T",DIE=130 D ^DIE K DR I $D(Y) S SRSOUT=1 40 I EMILY=2 D ^SROAUTL 41 Q 42 RET Q:SRSOUT W !!,"Press ENTER to continue, or '^' to quit " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q 43 Q 44 CONCUR ; concurrent case information 45 N SRPROC,SRCSTAT S SRLINE="" F I=1:1:80 S SRLINE=SRLINE_"-" 46 S CON=$P($G(^SRF(SRTN,"CON")),"^") I CON,($P($G(^SRF(CON,30)),"^")!($P($G(^SRF(CON,31)),"^",8))) S CON="" 47 S SRPAGE="" D HDR^SROAUTL 48 W !,"Concurrent case information cannot be updated using the Risk Assessment" 49 W !,"Module. To update the CPT code of a concurrent case, please use an option" 50 W !,"contained within the CPT/ICD9 Coding Menu." 51 I CON D CC W !!,"Concurrent Procedure: ",?22,SROPS(1) I $D(SROPS(2)) W !,?22,SROPS(2) I $D(SROPS(3)) W !,?22,SROPS(3) I $D(SROPS(4)) W !,?22,SROPS(4) 52 I $D(SRCSTAT) W !!,?22,SRCSTAT 53 W !!,"Press ENTER to continue " R X:DTIME 54 Q 55 CC ; list concurrent procedure 56 N SRTN,SRL,SRZ S SRCSTAT=">> Coding "_$S($P($G(^SRO(136,CON,10)),"^"):"",1:"Not ")_"Complete <<" 57 S SRL=55,SRTN=CON D CPTS^SROAUTL0 58 I SRPROC(1)="NOT ENTERED"!'$D(SRPROC(1)) S SRPROC(1)="CPT NOT ENTERED" K SRCSTAT 59 S SROPER=$P(^SRF(CON,"OP"),"^")_" (" F I=1:1 Q:'$D(SRPROC(I)) S SROPER=SROPER_SRPROC(I) 60 S SROPER=SROPER_")" 61 K SROPS,MM,MMM S:$L(SROPER)<57 SROPS(1)=SROPER 62 I $L(SROPER)>56 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM="" 63 Q 64 LOOP ; break procedures 65 S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<57 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM 66 Q 67 ANES K DR,DIE,DA S DA=SRTN,DR=".37T",DR(2,130.06)=".01T;.05T;42T",DIE=130 D ^DIE K DR 68 Q
Note:
See TracChangeset
for help on using the changeset viewer.
