source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSRO.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1GMTSRO ; SLC/JER,KER - All Surgery Reports ; 06/24/2002 [8/3/04 2:10pm]
2 ;;2.7;Health Summary;**9,11,28,37,57**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 3590 HS^SROGMTS
6 ;
7ENSRO ; Entry Point for Surgery Only Component
8 S GMTSSO=1
9 ;
10ENSR ; Entry Point for SURGERY REPORT component
11 ; (includes NON-OR procedures)
12 N GMTSMX,GMCOUNT,GMIDT,GMN,SURG,GMTSGL S GMTSGL=$$GL^GMTSROE Q:'$L(GMTSGL) Q:'$D(@(GMTSGL_"""B"","_DFN_")"))
13 S GMTSMX=999 I $D(GMTSNDM),(GMTSNDM>0) S GMTSMX=GMTSNDM
14 S GMN=0 F S GMN=$O(@(GMTSGL_"""B"","_DFN_","_GMN_")")) Q:GMN'>0 D SORT
15 Q:'$D(SURG) S (GMCOUNT,GMIDT)=0 F S GMIDT=$O(SURG(GMIDT)) Q:GMIDT'>0!(GMCOUNT'<GMTSMX) S GMN=SURG(GMIDT) D WRT Q:$D(GMTSQIT)
16 K GMTSSO Q
17 ;
18SORT ; Sort Surgeries by Inverse Date
19 N GMDT S GMDT=$P($G(@(GMTSGL_GMN_",0)")),U,9) I GMDT>GMTSBEG&(GMDT<GMTSEND) D
20 . F Q:'$D(SURG(9999999-GMDT)) S GMDT=GMDT+.0001
21 . S SURG(9999999-GMDT)=GMN
22 Q
23 ;
24WRT ; Write Surgical Case Record
25 N REC,X,GMI,GMJ,GMDT,GMTSTR
26 D:+($$PROK^GMTSU("SROGMTS",100))>0 HS^SROGMTS(GMN)
27 D:+($$PROK^GMTSU("SROGMTS",100))'>0 ONE^GMTSROE(GMN)
28NONOP ; Non-Op Procedure
29 ; Quit if Surgery Only
30 Q:$G(REC(130,GMN,118,"I"))="Y"&(+($G(GMTSSO))>0)
31 ; Print if SR*3*100
32 ;G:+($$PROK^GMTSU("SROGMTS",100))>0 OPER
33 I $G(REC(130,GMN,118,"I"))'="Y" G OPER
34 ; Print if NOT SR*3*100
35 I $G(REC(130,GMN,118,"I"))="Y" Q:$G(GMTSSO) D WRT^GMTSRON Q
36 S GMCOUNT=GMCOUNT+1
37OPER ; Operative Procedure
38SS ; Date/Specialty/Surgeon
39 D CKP^GMTSUP Q:$D(GMTSQIT)
40 S GMDT=$G(REC(130,GMN,.09,"S")) S:'$L(GMDT) GMDT=$$ED^GMTSU($G(REC(130,GMN,.09,"I")))
41 S GMTSTR=$G(REC(130,GMN,.04,"S")) S:$L($G(GMTSTR))>25 GMTSTR=$$WRAP^GMTSORC(GMTSTR,25)
42 W $G(GMDT),?21,$P($G(GMTSTR),"|"),?47,"Surgeon:",?56,$G(REC(130,GMN,.14,"E")),!
43 F GMI=2:1:$L($G(GMTSTR),"|") D CKP^GMTSUP Q:$D(GMTSQIT) W ?23,$P($G(GMTSTR),"|",GMI),!
44SPA ; Status/Principal Anesthetist
45 D CKP^GMTSUP Q:$D(GMTSQIT)
46 W ?13,"Status:",?21,$G(REC(130,GMN,"STATUS"))
47 W ?44,"Prin Anest:",?56,$G(REC(130,GMN,.31,"E")),!
48PREDX ; Principal Pre-Op Diagnosis
49 D CKP^GMTSUP Q:$D(GMTSQIT) W ?5,"Pre-op Diag(s):"
50 S GMTSTR=$G(REC(130,GMN,32,"S")) S:GMTSTR="" GMTSTR=$G(REC(130,GMN,32,"E"))
51 S:$L(GMTSTR)&($L($G(REC(130,GMN,"VERIFIED")))) GMTSTR=GMTSTR_" "_$G(REC(130,GMN,"VERIFIED")) S:$L(GMTSTR)>58 GMTSTR=$$WRAP^GMTSORC(GMTSTR,58)
52 F GMJ=1:1:$L(GMTSTR,"|") D Q:$D(GMTSQIT)
53 . D CKP^GMTSUP Q:$D(GMTSQIT) W ?$S(GMJ=1:21,1:22),$P(GMTSTR,"|",GMJ) W !
54 Q:$D(GMTSQIT)
55OPREDX ; Other Pre-Op Diagnosis
56 S GMI=0 F S GMI=$O(REC(130,GMN,130.17,GMI)) Q:GMI'>0 D
57 . S GMTSTR=$G(REC(130,GMN,130.17,GMI,.01,"S")) S:GMTSTR="" GMTSTR=$G(REC(130,GMN,130.17,GMI,.01,"E"))
58 . S:$L(GMTSTR)&($L($G(REC(130,GMN,"VERIFIED")))) GMTSTR=GMTSTR_" "_$G(REC(130,GMN,"VERIFIED")) S:$L(GMTSTR)>58 GMTSTR=$$WRAP^GMTSORC(GMTSTR,58)
59 . F GMJ=1:1:$L(GMTSTR,"|") D Q:$D(GMTSQIT)
60 . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?$S(GMJ=1:21,1:22),$P(GMTSTR,"|",GMJ) W !
61 Q:$D(GMTSQIT)
62PSTDX ; Post-Op Diagnosis
63 D CKP^GMTSUP Q:$D(GMTSQIT) W ?4,"Post-op Diag(s):"
64 S GMTSTR=$G(REC(130,GMN,34,"S")) S:GMTSTR="" GMTSTR=$G(REC(130,GMN,34,"E")) S:$L(GMTSTR)>58 GMTSTR=$$WRAP^GMTSORC(GMTSTR,58)
65 F GMJ=1:1:$L(GMTSTR,"|") D CKP^GMTSUP Q:$D(GMTSQIT) W ?$S(GMJ=1:21,1:22),$P(GMTSTR,"|",GMJ) W:GMJ=1&(GMTSTR?1.A.E) " ",$G(REC(130,GMN,"VERIFIED")) W !
66OPSTDX ; Other Post-Op Diagnosis
67 S GMI=0 F S GMI=$O(REC(130,GMN,130.18,GMI)) Q:GMI'>0 D
68 . S GMTSTR=$G(REC(130,GMN,130.18,GMI,.01,"S")) S:GMTSTR="" GMTSTR=$G(REC(130,GMN,130.18,GMI,.01,"E")) S:$L(GMTSTR)>58 GMTSTR=$$WRAP^GMTSORC(GMTSTR,58)
69 . F GMJ=1:1:$L(GMTSTR,"|") D CKP^GMTSUP Q:$D(GMTSQIT) W ?$S(GMJ=1:21,1:22),$P(GMTSTR,"|",GMJ) W:GMJ=1&(GMTSTR?1.A.E) " ",$G(REC(130,GMN,"VERIFIED")) W !
70OP ; Operative Procedures
71 D CKP^GMTSUP Q:$D(GMTSQIT) W ?2,"Operative Proc(s):" S GMTSTR=$G(REC(130,GMN,26,"S")) S:GMTSTR="" GMTSTR=$G(REC(130,GMN,26,"E")) S:$L(GMTSTR)>58 GMTSTR=$$WRAP^GMTSORC(GMTSTR,58)
72 F GMJ=1:1:$L(GMTSTR,"|") D Q:$D(GMTSQIT)
73 . D CKP^GMTSUP Q:$D(GMTSQIT) W ?$S(GMJ=1:21,1:22),$P(GMTSTR,"|",GMJ),!
74 Q:$D(GMTSQIT)
75OPM ; Operative Procedures (Modifiers)
76 S GMI=0 F S GMI=$O(REC(130,GMN,130.028,GMI)) Q:GMI'>0 D Q:$D(GMTSQIT)
77 . S GMTSTR=$G(REC(130,GMN,130.028,GMI,.01,"S")) S:GMTSTR="" GMTSTR=$G(REC(130,GMN,130.028,GMI,.01,"E")) S:$L(GMTSTR)>54 GMTSTR=$$WRAP^GMTSORC(GMTSTR,54)
78 . F GMJ=1:1:$L(GMTSTR,"|") D Q:$D(GMTSQIT)
79 . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?$S(GMJ=1:25,1:26),$P(GMTSTR,"|",GMJ),!
80 Q:$D(GMTSQIT)
81OOP ; Other Procedures
82 S GMI=0 F S GMI=$O(REC(130,GMN,130.16,GMI)) Q:GMI'>0 D
83 . S GMTSTR=$G(REC(130,GMN,130.16,GMI,.01,"S")) S:GMTSTR="" GMTSTR=$G(REC(130,GMN,130.16,GMI,.01,"E")) S:$L(GMTSTR)>58 GMTSTR=$$WRAP^GMTSORC(GMTSTR,58)
84 . F GMJ=1:1:$L(GMTSTR,"|") D Q:$D(GMTSQIT)
85 . . D CKP^GMTSUP Q:$D(GMTSQIT)
86 . . W ?$S(GMJ=1:21,1:22),$P(GMTSTR,"|",GMJ),!
87OOPM . ; Other Operative Procedures (Modifiers)
88 . N GMM S GMM=0 F S GMM=$O(REC(130,GMN,130.16,GMI,130.164,GMM)) Q:+GMM=0 D
89 . . S GMTSTR=$G(REC(130,GMN,130.16,GMI,130.164,GMM,.01,"S")) S:'$L(GMTSTR) GMTSTR=$G(REC(130,GMN,130.16,GMI,130.164,GMM,.01,"E")) S:$L(GMTSTR)>54 GMTSTR=$$WRAP^GMTSORC(GMTSTR,54)
90 . . F GMJ=1:1:$L(GMTSTR,"|") D Q:$D(GMTSQIT)
91 . . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?$S(GMJ=1:25,1:26),$P(GMTSTR,"|",GMJ),!
92 . Q:$D(GMTSQIT)
93 Q:$D(GMTSQIT)
94LAB ; Lab Work
95 I $L($G(REC(130,GMN,"LAB"))) D CKP^GMTSUP Q:$D(GMTSQIT) W ?11,"Lab Work: ",$G(REC(130,GMN,"LAB")),!
96RPTDT ; Dates
97DICDT ; Dictation Date
98 S GMTSTR=$G(REC(130,GMN,15,"S")) S:'$L(GMTSTR) GMTSTR=$G(REC(130,GMN,15,"E"))
99 I $L(GMTSTR) D CKP^GMTSUP Q:$D(GMTSQIT) W ?5,"Dictation Time:",?21,GMTSTR
100TRCDT ; Transcription Time
101 S GMTSTR=$G(REC(130,GMN,39,"S")) S:'$L(GMTSTR) GMTSTR=$G(REC(130,GMN,39,"E"))
102 I $L(GMTSTR) D CKP^GMTSUP Q:$D(GMTSQIT) W ?41,"Transcription Time:",?61,GMTSTR
103 D:$L($G(REC(130,GMN,15,"I")))!($L($G(REC(130,GMN,39,"I")))) CKP^GMTSUP Q:$D(GMTSQIT) W:$L($G(REC(130,GMN,15,"I")))!($L($G(REC(130,GMN,39,"I")))) !
104RPT ; Dictation
105 S GMCOUNT=+($G(GMCOUNT))+1
106 I $O(REC(130,GMN,1.15,0))>0 D
107 . I +($$PROK^GMTSU("SROGMTS",100))=0 N GMI D CKP^GMTSUP Q:$D(GMTSQIT) W "Surgeon's Dictation:",!
108 . S GMI=$S(+($$PROK^GMTSU("SROGMTS",100))=1:1,1:0) F S GMI=$O(REC(130,GMN,1.15,GMI)) Q:+GMI=0 D Q:$D(GMTSQIT)
109 . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?2,$G(REC(130,GMN,1.15,GMI)),!
110 Q:$D(GMTSQIT)
111 Q
Note: See TracBrowser for help on using the repository browser.