Changeset 623 for WorldVistAEHR/trunk/r/SURGERY-SR/SROASS.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SURGERY-SR/SROASS.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SURGERY-SR/SROASS.m
r613 r623 1 SROASS 2 ;;3.0; Surgery ;**38,47,64,94,121,100,160,166**;24 Jun 93;Build 73 PST 4 5 START 6 7 8 9 10 11 12 13 OPT 14 15 16 17 ENTER 18 19 20 21 22 23 24 25 26 27 28 I X=3 D @($S($P(SR("RA"),"^",2)="C":"^SROACOM1",1:"^SROACOM"))K SRTN G END29 30 EXCL 31 32 33 34 35 END 36 37 HELP 38 39 40 41 42 TRANS 43 44 45 46 1 SROASS ;BIR/MAM - SELECT ASSESSMENT ;01/18/07 2 ;;3.0; Surgery ;**38,47,64,94,121,100,160**;24 Jun 93;Build 7 3 PST K:$D(DUZ("SAV")) SRNEW K SRTN W !! S SRSOUT=0 4 N SRSEL D ^SROPSEL G:'$D(DFN) END S SRANM=VADM(1)_" "_VA("PID") 5 START ; start display 6 G:SRSOUT END W:SRSEL=1 @IOF,!,?1,SRANM 7 I $D(^DPT(DFN,.35)),$P(^(.35),"^") S SRDT=$P(^(.35),"^") W " * DIED "_$E(SRDT,4,5)_"/"_$E(SRDT,6,7)_"/"_$E(SRDT,2,3)_" *" 8 I SRSEL=2 S CNT=0 D ^SROASSN G:$D(SRTN) ENTER G PST 9 D ^SROASS1 I SRSOUT G END 10 I $D(SRTN) G ENTER 11 I $D(SRNEW) S CNT=CNT+1,SRCASE(CNT)="" W CNT,". ---- CREATE NEW ASSESSMENT" 12 I '$D(SRCASE(1)) W !!,"There are no Surgery Risk Assessments entered for "_VADM(1)_".",!! K DIR S DIR(0)="FOA",DIR("A")=" Press RETURN to continue. " D ^DIR Q 13 OPT W !!!,"Select Surgical Case: " R X:DTIME I '$T!("^"[X) S SRSOUT=1 G END 14 I '$D(SRCASE(X)) W !!,"Enter the number of the desired assessment." W:$D(SRNEW) " Select '"_CNT_"' to create an",!,"assessment for another surgical case." G OPT 15 I $D(SRNEW),X=CNT D ^SROANEW G END 16 I '$D(SRTN) S SRTN=+SRCASE(X) 17 ENTER ; edit, complete, or delete 18 I $D(SRPRINT)!'($D(SRNEW)) Q 19 S SR("RA")=$G(^SRF(SRTN,"RA")) I $P(SR("RA"),"^")="T" D TRANS I 'SRYN K SRASS,SRTN S:SRSEL=2 SRSOUT=1 G START 20 I SRATYPE="N"&($P(SR("RA"),"^",2)="C") W !!,"You've selected a Cardiac assessment, using a Non-Cardiac Option," K DIR S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="NO" D ^DIR S X=$E(X) I "Yy"'[X K SRTN S SRSOUT=1 G END 21 I SRATYPE="C"&($P(SR("RA"),"^",2)="N") W !!,"You've selected a Non-Cardiac assessment, using a Cardiac Option," K DIR S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="NO" D ^DIR S X=$E(X) I "Yy"'[X K SRTN S SRSOUT=1 G END 22 W @IOF,!,?1,SRANM,!! S SRSDATE=$P(^SRF(SRTN,0),"^",9) S SRASS=SRTN D DISP^SROASS1 23 I SRATYPE="N" D EXCL 24 W !!,"1. Enter Risk Assessment Information",!,"2. Delete Risk Assessment Entry",!,"3. Update Assessment Status to 'COMPLETE'" 25 W !!,"Select Number: 1// " R X:DTIME I '$T!(X["^") K SRTN,SRASS S SRSOUT=1 G END 26 S:X="" X=1 I X<1!(X>3)!(X'?.N) D HELP G ENTER 27 I X=2 D ^SROADEL W !!,"Press <RET> to continue " R X:DTIME W @IOF K SRTN G END 28 I X=3 D ^SROACOM K SRTN G END 29 Q 30 EXCL I $P($G(^SRO(136,SRTN,10)),"^"),'$$XL^SROAX(SRTN) D 31 .W !!,">>> Based on CPT Codes assigned for this case, this case should be excluded." Q 32 N SRPROC,SRL S SRL=49 D CPTS^SROAUTL0 I SRPROC(1)="NOT ENTERED" D 33 .W !!,">>> No CPT Codes have been assigned for this case." 34 Q 35 END S:'$D(SRSOUT) SRSOUT=1 W:SRSOUT @IOF D ^SRSKILL 36 Q 37 HELP ; 38 W !!,"Enter <RET> or '1' to enter or edit information related to this Risk ",!,"Assessment entry. If you want to delete the Assessment, enter '2'." 39 W !,"Enter '3' to update the status of this Assessment to 'COMPLETE'." 40 W !!,"Press <RET> to continue " R X:DTIME 41 Q 42 TRANS W @IOF,!,"This assessment has already been transmitted. The information contained",!,"in it cannot be altered unless you first change the status to 'INCOMPLETE'." 43 S SRYN=0 K DIR S DIR("A")="Do you wish to change the status of this assessment to 'INCOMPLETE'",DIR("B")="NO",DIR(0)="Y" D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q 44 S SRYN=Y I 'SRYN Q 45 I $$LOCK^SROUTL(SRTN) K DA,DIE,DR S DIE=130,DA=SRTN,DR="235////I;393////1" D ^DIE K DA,DIE,DR D UNLOCK^SROUTL(SRTN) 46 Q
Note:
See TracChangeset
for help on using the changeset viewer.
