source: WorldVistAEHR/trunk/r/SURGERY-SR/SRONASS.m@ 691

Last change on this file since 691 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1SRONASS ;B'HAM ISC/MAM - NO ASSESSMENT REASON ; [ 04/13/04 10:30 PM ]
2 ;;3.0; Surgery ;**38,47,83,107,121,100,125**;24 Jun 93
3 K SRTN S SRSOUT=0 N SRSEL D ^SROPSEL I '$D(DFN) S SRSOUT=1 G END
4 D @$S(SRSEL=2:"^SROPSN",1:"STL^SROPS") I '$D(SRTN) S SRSOUT=1 G END
5 S X=$P($G(^SRF(SRTN,"RA")),"^",6) I X="Y" D ASS I 'OK G END
6 N SRLCK S SRLCK=$$LOCK^SROUTL(SRTN) I 'SRLCK G END
7 D SRA^SROES
8 W ! K DIR S X=$P($G(^SRF(SRTN,"RA")),"^",7) I X'="" D SET S DIR("B")=X
9 S DIR(0)="130,102",DIR("A")="Reason an Assessment was not Created" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!(Y=""&(X'="@")) S SRSOUT=1 G END
10 I X="@" D DELETE G END1
11 I X'="" K DR,DA,DIE S DIE=130,DR="102///"_X_";323////N;284////N;Q;235////C",DA=SRTN D ^DIE K DR,DIE,DA
12 D ^SROAEX S SROERR=SRTN D ^SROERR0
13END1 K DA,DIK S DIK="^SRF(",DIK(1)=".232^AQ",DA=SRTN D EN1^DIK
14 D EXIT^SROES
15END I $G(SRLCK) D UNLOCK^SROUTL(SRTN)
16 K SRTN D ^SRSKILL W @IOF
17 Q
18LOOP ; break procedure
19 S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<60 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
20 Q
21OTHER ; other operations
22 S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,SROTHER,0),"^"))>235 S SRLONG=0,SROTHER=999,SROPERS=" ..."
23 I SRLONG S SROPERS=$P(^SRF(SRTN,13,SROTHER,0),"^")
24 S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)
25 Q
26SET ; expand reason for no assessment code
27 S Y=X,C=$P(^DD(130,102,0),"^",2) D Y^DIQ S X=Y
28 Q
29ASS ; assessment already exists
30 S OK=0 W !!,"According to your records, an assessment should be created for this surgical",!,"case."
31ASK W !!,"Do you want to update this information and not create a surgery risk ",!,"assessment for this case ? NO// " R SRYN:DTIME I '$T!(SRYN["^") S OK="" Q
32 S SRYN=$E(SRYN) S:SRYN="" SRYN="N" I "YyNn"'[SRYN S SRYN="?"
33 I SRYN="?" W !!,"If this case will not be used for the risk assessment study, Enter 'YES' to ",!,"change the status. You will then be prompted for the reason that no assessment",!,"was done. Enter 'NO' to leave this case unchanged."
34 I SRYN="?" G ASK
35 I "Yy"[SRYN S OK=1
36 I "Nn"[SRYN W !!,"No action taken.",!!,"Press RETURN to continue " R X:DTIME
37 Q
38DELETE ; delete no assessment reason
39 W !!,"If you delete the reason why no assessment was created for this case, the",!,"computer will automatically update your records to make this a non-assessed",!,"case."
40 W !!,"Are you sure that you want to delete the reason ? NO// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
41 S SRYN=$E(SRYN) S:SRYN="" SRYN="N" I "YyNn"'[SRYN S SRYN="?"
42 I SRYN="?" W !!,"By entering an '@', you have told the computer that you want to remove the ",!,"reason why no assessment was created for this case. If this reason should be",!,"deleted, enter 'YES'." G DELETE
43 I "Nn"[SRYN S SRSOUT=1 W !!,"No action taken.",!!,"Press RETURN to continue " R X:DTIME Q
44 W !!,"Updating to non-assessed status..." D DRDEL W !!,"Press RETURN to continue " R X:DTIME
45 Q
46DRDEL K DR,DIE,DA S DIE=130,DA=SRTN,DR="235///@;284///@;393///@;260///@;272///@;323///@;102///@;260.1///@" D ^DIE K DR,DIE,DA
47 Q
Note: See TracBrowser for help on using the repository browser.