source: WorldVistAEHR/trunk/r/SURGERY-SR/SROAEX.m@ 1476

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1SROAEX ;BIR/MAM - EXCLUSION CRITERIA ;03/22/07
2 ;;3.0; Surgery ;**38,47,63,88,142,153,160**;24 Jun 93;Build 7
3 N SRCSTAT S SRACLR=0,SRSOUT=0 D NCODE^SROAUTL
4START D:SRACLR RET G:SRSOUT END S SRACLR=0 K SRA,SRAO S SRAO(4)=""
5 S SR(0)=^SRF(SRTN,0),Y=$P($G(^SRF(SRTN,"RA")),"^",7) D CRITERIA S SRAO(1)=NYUK_"^102"
6 S SRAO(2)=$P(SR(0),"^",10)_"^.035",X=$P(SRAO(2),"^") I X'="" S $P(SRAO(2),"^")=$S(X="EL":"ELECTIVE",X="EM":"EMERGENT",X="U":"URGENT",X="A":"ADD ON TODAY (NONEMERGENT)",X="S":"STANDBY",1:"")
7 S SHEMP=$P(SR(0),"^",4) S:SHEMP SHEMP=$P(^SRO(137.45,SHEMP,0),"^"),SRAO(3)=SHEMP_"^.04"
8 S SRCSTAT=">> Coding "_$S($P($G(^SRO(136,SRTN,10)),"^"):"",1:"Not ")_"Complete <<"
9 D TECH^SROPRIN S:SRTECH="NOT ENTERED" SRTECH="" S SRAO(5)=SRTECH
10 D TSTAT^SRO1L1,HDR^SROAUTL
11 W !,"1. Exclusion Criteria: ",?35,$P(SRAO(1),"^"),!,"2. Surgical Priority:",?35,$P(SRAO(2),"^"),!,"3. Surgical Specialty:",?35,$P(SRAO(3),"^")
12 N SRPROC,SRL S SRL=45 D CPTS^SROAUTL0 W !,"4. CPT Codes (view only):"
13 F I=1:1 Q:'$D(SRPROC(I)) W:I=1 ?35,SRPROC(I) W:I'=1 !,?35,SRPROC(I)
14 W !,"5. Principal Anesthesia Technique: "_$P(SRAO(5),"^"),!! F LINE=1:1:80 W "-"
15ASK W !!,"Select Excluded Case Information to Edit: " R X:DTIME I '$T!("^"[X) G END
16 S:X="a" X="A" I '$D(SRAO(X)),(X'?.N1":".N),(X'="A") D HELP G:SRSOUT END G START
17 I X="A" S X="1:5"
18 I X?.N1":".N S Y=$E(X),Z=$P(X,":",2) I Y<1!(Z>5)!(Y>Z) D HELP G:SRSOUT END G START
19 D TSTAT^SRO1L1,HDR^SROAUTL
20 I X?.N1":".N D RANGE,AQ G START
21 I $D(SRAO(X)) S EMILY=X W !! D ONE,AQ G START
22END D AQ W @IOF D ^SRSKILL
23 Q
24HELP W @IOF,!!!!,"Enter the number or range of numbers you want to edit. Examples of proper"
25 W !,"responses are listed below.",!!,"1. Enter 'A' to update all information."
26 W !!,"2. Enter a number (1-5) to update the information in that field. (For"
27 W !," example, enter '2' to update Surgical Priority)"
28 W !!,"3. Enter a range of numbers (1-5) separated by a ':' to enter a range of"
29 W !," information. (For example, enter '1:2' to update the Exclusion Criteria "
30 W !," and Surgical Priority)" D RET
31 Q
32AQ ; update transmission status
33 K DA,DIK S DIK="^SRF(",DIK(1)=".232^AQ",DA=SRTN D EN1^DIK K DA,DIK
34 Q
35RANGE ; range of numbers
36 W !! S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) F EMILY=SHEMP:1:CURLEY Q:SRSOUT D ONE I EMILY=4 D HDR^SROAUTL
37 Q
38ONE ; edit one item
39 I EMILY=1 D REASON Q
40 I EMILY=4 D DISP^SROAUTL0 Q
41 I EMILY=5 D UPANES Q
42 K DR,DIE S DA=SRTN,DR=$P(SRAO(EMILY),"^",2)_"T",DIE=130 D ^DIE K DR I $D(Y) S SRSOUT=1
43 Q
44RET Q:SRSOUT W ! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
45 Q
46CRITERIA ; expand set of codes for exclusion criteria
47 S C=$P(^DD(130,102,0),"^",2) D Y^DIQ S NYUK=Y
48 S SHEMP=$P(^SRF(SRTN,0),"^",10),MOE=$S(SHEMP="E":"ELECTIVE",SHEMP="M":"EMERGENCY",SHEMP="U":"URGENT",1:"")
49 Q
50UPANES K DR,DIE,DA S DA=SRTN,DR=.37,DR(2,130.06)=".01T;.05T;42T",DIE=130 D ^DIE K DR
51 Q
52REASON W ! K DIR S DIR(0)="130,102",DIR("A")="Reason for not Creating an Assessment",DIR("B")=$P(SRAO(1),"^") D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
53 I X="@" D DELETE^SRONASS S SRSOUT=1 Q
54 I Y'="" K DR,DIE,DA S DA=SRTN,DIE=130,DR="102////"_Y D ^DIE K DA,DIE,DR
55 Q
Note: See TracBrowser for help on using the repository browser.