source: FOIAVistA/tag/r/HEALTH_SUMMARY-GMTS/GMTSRON.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1GMTSRON ; SLC/JER,KER - Surgery Reports ; 06/24/2002 [7/27/04 9:00am]
2 ;;2.7;Health Summary;**11,28,37,57**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 3590 HS^SROGMTS
6 ; DBIA 2056 $$GET1^DIQ (file #130)
7 ;
8ENSR ; Entry point for component
9 N REC,GMTSMX,GMCOUNT,GMIDT,GMJ,GMN,SURG,GMTSGL
10 S GMTSGL=$$GL^GMTSROE Q:'$L(GMTSGL) Q:'$D(@(GMTSGL_"""B"","_DFN_")"))
11 S GMTSMX=999 I $D(GMTSNDM),(GMTSNDM>0) S GMTSMX=GMTSNDM
12 S GMN=0 F S GMN=$O(@(GMTSGL_"""B"","_DFN_","_GMN_")")) Q:GMN'>0 D SORT
13 Q:'$D(SURG) S (GMCOUNT,GMIDT)=0 F S GMIDT=$O(SURG(GMIDT)) Q:GMIDT'>0!(GMCOUNT'<GMTSMX) D
14 . S GMN=SURG(GMIDT) K REC I $$CHK D WRT
15 K REC
16 Q
17 ;
18SORT ; Sort surgeries by inverted 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 S GMN=+($G(GMN))
26 D:+($$PROK^GMTSU("SROGMTS",100))>0 HS^SROGMTS(GMN)
27 D:+($$PROK^GMTSU("SROGMTS",100))'>0 ONE^GMTSROE(GMN)
28 N X,Y,GMI,GMDT,GMTSTR
29 ;-------------------------------------------------------
30 Q:$G(REC(130,GMN,118,"I"))'="Y" S GMCOUNT=GMCOUNT+1
31NONOR ; NON-OR information
32SP ; Date/Specialty/Provider
33 D CKP^GMTSUP Q:$D(GMTSQIT)
34 S GMDT=$G(REC(130,GMN,.09,"S")) S:'$L(GMDT) GMDT=$$ED^GMTSU($G(REC(130,GMN,.09,"I")))
35 S GMTSTR=$G(REC(130,GMN,125,"S")) S:$L($G(GMTSTR))>25 GMTSTR=$$WRAP^GMTSORC(GMTSTR,25)
36 D CKP^GMTSUP Q:$D(GMTSQIT)
37 W GMDT,?21,$P($G(GMTSTR),"|"),?47,"Provider: ",?56,$G(REC(130,GMN,123,"E")),!
38 F GMI=2:1:$L($G(GMTSTR),"|") D CKP^GMTSUP Q:$D(GMTSQIT) W ?23,$P($G(GMTSTR),"|",GMI),!
39 ;
40SA ; Status/Attending
41 D CKP^GMTSUP Q:$D(GMTSQIT)
42 W ?13,"Status:",?21,$G(REC(130,GMN,"STATUS"))
43 W ?46,"Attending: ",?56,$G(REC(130,GMN,124,"E")),!
44PA ; Principal Anesthetist
45 D CKP^GMTSUP Q:$D(GMTSQIT)
46 W ?45,"Prin Anest: ",?56,$G(REC(130,GMN,.31,"E")),!
47PD ; Principle Diagnosis
48 S GMTSTR=$G(REC(130,GMN,33,"S")) S:'$L(GMTSTR) GMTSTR=$G(REC(130,GMN,33,"E"))
49 S:$L($G(GMTSTR))>39 GMTSTR=$$WRAP^GMTSORC(GMTSTR,39)
50 D CKP^GMTSUP Q:$D(GMTSQIT) W ?9,"Princ Diag: ",$P($G(GMTSTR),"|"),!
51 F GMI=2:1:$L($G(GMTSTR),"|") D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,$P($G(GMTSTR),"|",GMI),!
52PP ; Principal Procedure
53 D CKP^GMTSUP Q:$D(GMTSQIT) W ?5,"Proc Performed: "
54 S GMTSTR=$G(REC(130,GMN,26,"S"))
55 S:GMTSTR="" GMTSTR=$G(REC(130,GMN,26,"E"))
56 S:$L(GMTSTR)>58 GMTSTR=$$WRAP^GMTSORC(GMTSTR,58)
57 F GMJ=1:1:$L(GMTSTR,"|") D Q:$D(GMTSQIT)
58 . D CKP^GMTSUP Q:$D(GMTSQIT) W ?$S(GMJ=1:21,1:22),$P(GMTSTR,"|",GMJ),!
59 Q:$D(GMTSQIT)
60PPM ; Principal Procedure (Modifiers)
61 S GMI=0 F S GMI=$O(REC(130,GMN,130.028,GMI)) Q:GMI'>0 D Q:$D(GMTSQIT)
62 . 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)
63 . F GMJ=1:1:$L(GMTSTR,"|") D Q:$D(GMTSQIT)
64 . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?$S(GMJ=1:25,1:26),$P(GMTSTR,"|",GMJ),!
65 Q:$D(GMTSQIT)
66OPP ; Other Procedure Performed
67 S GMI=0 F S GMI=$O(REC(130,GMN,130.16,GMI)) Q:GMI'>0 D
68 . 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)
69 . F GMJ=1:1:$L(GMTSTR,"|") D Q:$D(GMTSQIT)
70 . . D CKP^GMTSUP Q:$D(GMTSQIT)
71 . . W ?$S(GMJ=1:21,1:22),$P(GMTSTR,"|",GMJ),!
72OPPM . ; Other Procedure Performed (Modifiers)
73 . N GMM S GMM=0
74 . F S GMM=$O(REC(130,GMN,130.16,GMI,130.164,GMM)) Q:+GMM=0 D
75 . . 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)
76 . . F GMJ=1:1:$L(GMTSTR,"|") D Q:$D(GMTSQIT)
77 . . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?$S(GMJ=1:25,1:26),$P(GMTSTR,"|",GMJ),!
78 . Q:$D(GMTSQIT)
79 Q:$D(GMTSQIT)
80IND ; Indications for Surgery
81 I $G(REC(130,GMN,55,"S",0))>0 D Q:$D(GMTSQIT)
82 . N GMI,GMC S (GMI,GMC)=0 F S GMI=$O(REC(130,GMN,55,"S",GMI)) Q:+GMI=0 D Q:$D(GMTSQIT)
83 . . S GMC=+GMC+1 D CKP^GMTSUP Q:$D(GMTSQIT) W:GMC=1 "Indication for Proc:" W ?21,$G(REC(130,GMN,55,"S",GMI)),!
84FIND ; Findings
85 I $G(REC(130,GMN,59,"S",0))>0 D Q:$D(GMTSQIT)
86 . N GMI,GMC S (GMI,GMC)=0 F S GMI=$O(REC(130,GMN,59,"S",GMI)) Q:+GMI=0 D Q:$D(GMTSQIT)
87 . . S GMC=+GMC+1 D CKP^GMTSUP Q:$D(GMTSQIT) W:GMC=1 " Operative Findings:" W ?21,$G(REC(130,GMN,59,"S",GMI)),!
88DICT ; Dictation
89 I $O(REC(130,GMN,1.15,0))>0 D
90 . N GMI D CKP^GMTSUP Q:$D(GMTSQIT) W "Surgeon's Dictation:",!
91 . S GMI=0 F S GMI=$O(REC(130,GMN,1.15,GMI)) Q:+GMI=0 D Q:$D(GMTSQIT)
92 . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?2,$G(REC(130,GMN,1.15,GMI)),!
93 Q
94 ;--------------------------------------------------------------------
95CHK() ; For selected procedures see if you have a match
96 N GMTSI,GMTSF,GMTSC
97 S GMTSC=$$GET1^DIQ(130,+($G(GMN)),27,"I") Q:'$D(GMTSEG(GMTSEGN,81)) 1
98 S GMTSF=0 F GMTSI=0:0 S GMTSI=$O(GMTSEG(GMTSEGN,81,GMTSI)) Q:'+GMTSI!GMTSF S:GMTSEG(GMTSEGN,81,GMTSI)=GMTSC GMTSF=1 Q:GMTSF
99 Q GMTSF
Note: See TracBrowser for help on using the repository browser.