1 | SROAOP1 ;BIR/MAM - SET OPERATION INFO ;02/28/07
|
---|
2 | ;;3.0; Surgery ;**38,47,63,81,88,95,97,125,142,153,160**;24 Jun 93;Build 7
|
---|
3 | N SRCSTAT K SRA,SRAO F I=0,200,"OP" S SRA(I)=$G(^SRF(SRTN,I))
|
---|
4 | S SRDOC="Surgeon: "_$P(^VA(200,$P(^SRF(SRTN,.1),"^",4),0),"^") F I=3,4,5 S SRAO(I)=""
|
---|
5 | K SROPS S SROPER=$P(SRA("OP"),"^")
|
---|
6 | S SRAO(2)="^26"
|
---|
7 | S:$L(SROPER)<49 SROPS(1)=SROPER K M,MM,MMM I $L(SROPER)>48 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
|
---|
8 | S X=$P(SRA(0),"^",4) S:X X=$P(^SRO(137.45,X,0),"^",1) S SRAO(1)=X_"^.04"
|
---|
9 | S SRHDR(.5)=SRDOC,SRPAGE="PAGE: 1 OF 2"
|
---|
10 | S SRCSTAT=">> Coding "_$S($P($G(^SRO(136,SRTN,10)),"^"):"",1:"Not ")_"Complete <<"
|
---|
11 | D HDR^SROAUTL
|
---|
12 | S X=$P($G(^SRO(136,SRTN,0)),"^",3) S:X X=$$ICDDX^ICDCODE(X,$P($G(^SRF(SRTN,0)),"^",9)),X=$P(X,"^",2)_" "_$P(X,"^",4)
|
---|
13 | W "Postop Diagnosis Code (ICD9): ",$S(X'="":X,1:"NOT ENTERED"),!
|
---|
14 | W !," 1. Surgical Specialty: ",?33,$P(SRAO(1),"^"),!," 2. Principal Operation: ",?33,SROPS(1) I $D(SROPS(2)) W !,?33,SROPS(2) I $D(SROPS(3)) W !,?33,SROPS(3) I $D(SROPS(4)) W !,?33,SROPS(4)
|
---|
15 | N SRPROC,SRL S SRL=49 D CPTS^SROAUTL0 W !," 3. CPT Codes (view only):" I SRPROC(1)="" S SRPROC(1)="NOT ENTERED"
|
---|
16 | F I=1:1 Q:'$D(SRPROC(I)) W:I=1 ?33,SRPROC(I) W:I'=1 !,?33,SRPROC(I)
|
---|
17 | W !," 4. Other Procedures:" W:$O(^SRF(SRTN,13,0)) ?33,"***INFORMATION ENTERED***"
|
---|
18 | W !," 5. Concurrent Procedure:" S CON=$P($G(^SRF(SRTN,"CON")),"^") I CON,'($P($G(^SRF(CON,30)),"^")!($P($G(^SRF(CON,31)),"^",8))) W ?33,"***INFORMATION ENTERED***"
|
---|
19 | S X=$P(SRA(200),"^",52),SRAO(6)=X_"^214",NYUK=$P(SRA(0),"^",10) D EMERG S SRAO(7)=SHEMP_"^.035"
|
---|
20 | S Y=$P($G(^SRF(SRTN,"1.0")),"^",8),C=$P(^DD(130,1.09,0),"^",2) D:Y'="" Y^DIQ S SRAO(8)=Y_"^1.09"
|
---|
21 | S Y=$P($G(^SRF(SRTN,1.1)),"^",3),C=$P(^DD(130,1.13,0),"^",2) D:Y'="" Y^DIQ S SRAO(9)=Y_"^1.13"
|
---|
22 | D TECH^SROPRIN S SRAO(10)=SRTECH
|
---|
23 | S X=$P(SRA(200),"^",54),SRAO(11)=X_"^340" K SRA(.2)
|
---|
24 | S Y=$P($G(^SRF(SRTN,200.1)),"^",4) D
|
---|
25 | .I Y="" S (Y,$P(^SRF(SRTN,200.1),"^",4))="N"
|
---|
26 | .S C=$P(^DD(130,443,0),"^",2) D:Y'="" Y^DIQ S SRAO(12)=Y_"^443"
|
---|
27 | S Y=$P($G(^SRF(SRTN,200.1)),"^",6) D
|
---|
28 | .I Y="" S (Y,$P(^SRF(SRTN,200.1),"^",6))="N"
|
---|
29 | .S C=$P(^DD(130,446,0),"^",2) D:Y'="" Y^DIQ S SRAO(13)=Y_"^446"
|
---|
30 | W !," 6. PGY of Primary Surgeon:",?33,$P(SRAO(6),"^"),!," 7. Surgical Priority:",?33,$P(SRAO(7),"^"),!," 8. Wound Classification: ",?33,$P(SRAO(8),"^")
|
---|
31 | W !," 9. ASA Classification:",?33,$P(SRAO(9),"^")
|
---|
32 | W !,"10. Princ. Anesthesia Technique: ",$P(SRAO(10),"^")
|
---|
33 | W !,"11. RBC Units Transfused:",?33,$P(SRAO(11),"^")
|
---|
34 | W !,"12. Intraop Disseminated Cancer:",?33,$P(SRAO(12),"^")
|
---|
35 | W !,"13. Intraoperative Ascites:",?33,$P(SRAO(13),"^")
|
---|
36 | W ! F LINE=1:1:80 W "-"
|
---|
37 | Q
|
---|
38 | YN S SHEMP=$S(NYUK="NS":"NS",NYUK="N":"NO",NYUK="Y":"YES",1:"")
|
---|
39 | Q
|
---|
40 | LOOP ; break procedures
|
---|
41 | S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<49 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
|
---|
42 | Q
|
---|
43 | EMERG ; surgical priority
|
---|
44 | I NYUK="" S SHEMP="" Q
|
---|
45 | S Y=NYUK,C=$P(^DD(130,.035,0),"^",2) D Y^DIQ S SHEMP=Y
|
---|
46 | Q
|
---|