- GMTSRON ; SLC/JER,KER - Surgery Reports ; 06/24/2002 [7/27/04 9:00am]
- ;;2.7;Health Summary;**11,28,37,57,106**;Oct 20, 1995;Build 11
- ;
- ; External References
- ; DBIA 3590 HS^SROGMTS
- ; DBIA 2056/4872 $$GET1^DIQ (file #136)
- ;
- ENSR ; Entry point for component
- N REC,GMTSMX,GMCOUNT,GMIDT,GMJ,GMN,SURG,GMTSGL
- S GMTSGL=$$GL^GMTSROE Q:'$L(GMTSGL) Q:'$D(@(GMTSGL_"""B"","_DFN_")"))
- S GMTSMX=999 I $D(GMTSNDM),(GMTSNDM>0) S GMTSMX=GMTSNDM
- S GMN=0 F S GMN=$O(@(GMTSGL_"""B"","_DFN_","_GMN_")")) Q:GMN'>0 D SORT
- Q:'$D(SURG) S (GMCOUNT,GMIDT)=0 F S GMIDT=$O(SURG(GMIDT)) Q:GMIDT'>0!(GMCOUNT'<GMTSMX) D
- . S GMN=SURG(GMIDT) K REC I $$CHK D WRT
- K REC
- Q
- ;
- SORT ; Sort surgeries by inverted date
- N GMDT S GMDT=$P($G(@(GMTSGL_GMN_",0)")),U,9) I GMDT>GMTSBEG&(GMDT<GMTSEND) D
- . F Q:'$D(SURG(9999999-GMDT)) S GMDT=GMDT+.0001
- . S SURG(9999999-GMDT)=GMN
- Q
- ;
- WRT ; Write surgical case record
- S GMN=+($G(GMN))
- D:+($$PROK^GMTSU("SROGMTS",100))>0 HS^SROGMTS(GMN)
- D:+($$PROK^GMTSU("SROGMTS",100))'>0 ONE^GMTSROE(GMN)
- N X,Y,GMI,GMDT,GMTSTR
- ;-------------------------------------------------------
- Q:$G(REC(130,GMN,118,"I"))'="Y" S GMCOUNT=GMCOUNT+1
- NONOR ; NON-OR information
- SP ; Date/Specialty/Provider
- D CKP^GMTSUP Q:$D(GMTSQIT)
- S GMDT=$G(REC(130,GMN,.09,"S")) S:'$L(GMDT) GMDT=$$ED^GMTSU($G(REC(130,GMN,.09,"I")))
- S GMTSTR=$G(REC(130,GMN,125,"S")) S:$L($G(GMTSTR))>25 GMTSTR=$$WRAP^GMTSORC(GMTSTR,25)
- D CKP^GMTSUP Q:$D(GMTSQIT)
- W GMDT,?21,$P($G(GMTSTR),"|"),?47,"Provider: ",?56,$G(REC(130,GMN,123,"E")),!
- F GMI=2:1:$L($G(GMTSTR),"|") D CKP^GMTSUP Q:$D(GMTSQIT) W ?23,$P($G(GMTSTR),"|",GMI),!
- ;
- SA ; Status/Attending
- D CKP^GMTSUP Q:$D(GMTSQIT)
- W ?13,"Status:",?21,$G(REC(130,GMN,"STATUS"))
- W ?46,"Attending: ",?56,$G(REC(130,GMN,124,"E")),!
- PA ; Principal Anesthetist
- D CKP^GMTSUP Q:$D(GMTSQIT)
- W ?45,"Prin Anest: ",?56,$G(REC(130,GMN,.31,"E")),!
- PD ; Principle Diagnosis
- S GMTSTR=$G(REC(130,GMN,33,"S")) S:'$L(GMTSTR) GMTSTR=$G(REC(130,GMN,33,"E"))
- S:$L($G(GMTSTR))>39 GMTSTR=$$WRAP^GMTSORC(GMTSTR,39)
- D CKP^GMTSUP Q:$D(GMTSQIT) W ?9,"Princ Diag: ",$P($G(GMTSTR),"|"),!
- F GMI=2:1:$L($G(GMTSTR),"|") D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,$P($G(GMTSTR),"|",GMI),!
- PP ; Principal Procedure
- D CKP^GMTSUP Q:$D(GMTSQIT) W ?5,"Proc Performed: "
- 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)
- F GMJ=1:1:$L(GMTSTR,"|") D Q:$D(GMTSQIT)
- . D CKP^GMTSUP Q:$D(GMTSQIT) W ?$S(GMJ=1:21,1:22),$P(GMTSTR,"|",GMJ),!
- Q:$D(GMTSQIT)
- PPM ; Principal Procedure (Modifiers)
- S GMI=0 F S GMI=$O(REC(130,GMN,130.028,GMI)) Q:GMI'>0 D Q:$D(GMTSQIT)
- . 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)
- . F GMJ=1:1:$L(GMTSTR,"|") D Q:$D(GMTSQIT)
- . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?$S(GMJ=1:25,1:26),$P(GMTSTR,"|",GMJ),!
- Q:$D(GMTSQIT)
- OPP ; Other Procedure Performed
- S GMI=0 F S GMI=$O(REC(130,GMN,130.16,GMI)) Q:GMI'>0 D
- . 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)
- . F GMJ=1:1:$L(GMTSTR,"|") D Q:$D(GMTSQIT)
- . . D CKP^GMTSUP Q:$D(GMTSQIT)
- . . W ?$S(GMJ=1:21,1:22),$P(GMTSTR,"|",GMJ),!
- OPPM . ; Other Procedure Performed (Modifiers)
- . N GMM S GMM=0
- . F S GMM=$O(REC(130,GMN,130.16,GMI,130.164,GMM)) Q:+GMM=0 D
- . . 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)
- . . F GMJ=1:1:$L(GMTSTR,"|") D Q:$D(GMTSQIT)
- . . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?$S(GMJ=1:25,1:26),$P(GMTSTR,"|",GMJ),!
- . Q:$D(GMTSQIT)
- Q:$D(GMTSQIT)
- IND ; Indications for Surgery
- I $G(REC(130,GMN,55,"S",0))>0 D Q:$D(GMTSQIT)
- . N GMI,GMC S (GMI,GMC)=0 F S GMI=$O(REC(130,GMN,55,"S",GMI)) Q:+GMI=0 D Q:$D(GMTSQIT)
- . . 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)),!
- FIND ; Findings
- I $G(REC(130,GMN,59,"S",0))>0 D Q:$D(GMTSQIT)
- . N GMI,GMC S (GMI,GMC)=0 F S GMI=$O(REC(130,GMN,59,"S",GMI)) Q:+GMI=0 D Q:$D(GMTSQIT)
- . . S GMC=+GMC+1 D CKP^GMTSUP Q:$D(GMTSQIT) W:GMC=1 " Operative Findings:" W ?21,$G(REC(130,GMN,59,"S",GMI)),!
- DICT ; Dictation
- I $O(REC(130,GMN,1.15,0))>0 D
- . N GMI D CKP^GMTSUP Q:$D(GMTSQIT) W "Surgeon's Dictation:",!
- . S GMI=0 F S GMI=$O(REC(130,GMN,1.15,GMI)) Q:+GMI=0 D Q:$D(GMTSQIT)
- . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?2,$G(REC(130,GMN,1.15,GMI)),!
- Q
- ;--------------------------------------------------------------------
- CHK() ; For selected procedures see if you have a match
- N GMTSI,GMTSF,GMTSC
- S GMTSC=$$GET1^DIQ(136,+($G(GMN)),.02,"I") Q:'$D(GMTSEG(GMTSEGN,81)) 1 ; p.106 $$GET1^DIQ call changed to file 136
- 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
- Q GMTSF
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRON 5194 printed Mar 13, 2025@21:05:04 Page 2
- GMTSRON ; SLC/JER,KER - Surgery Reports ; 06/24/2002 [7/27/04 9:00am]
- +1 ;;2.7;Health Summary;**11,28,37,57,106**;Oct 20, 1995;Build 11
- +2 ;
- +3 ; External References
- +4 ; DBIA 3590 HS^SROGMTS
- +5 ; DBIA 2056/4872 $$GET1^DIQ (file #136)
- +6 ;
- ENSR ; Entry point for component
- +1 NEW REC,GMTSMX,GMCOUNT,GMIDT,GMJ,GMN,SURG,GMTSGL
- +2 SET GMTSGL=$$GL^GMTSROE
- if '$LENGTH(GMTSGL)
- QUIT
- if '$DATA(@(GMTSGL_"""B"","_DFN_")"))
- QUIT
- +3 SET GMTSMX=999
- IF $DATA(GMTSNDM)
- IF (GMTSNDM>0)
- SET GMTSMX=GMTSNDM
- +4 SET GMN=0
- FOR
- SET GMN=$ORDER(@(GMTSGL_"""B"","_DFN_","_GMN_")"))
- if GMN'>0
- QUIT
- DO SORT
- +5 if '$DATA(SURG)
- QUIT
- SET (GMCOUNT,GMIDT)=0
- FOR
- SET GMIDT=$ORDER(SURG(GMIDT))
- if GMIDT'>0!(GMCOUNT'<GMTSMX)
- QUIT
- Begin DoDot:1
- +6 SET GMN=SURG(GMIDT)
- KILL REC
- IF $$CHK
- DO WRT
- End DoDot:1
- +7 KILL REC
- +8 QUIT
- +9 ;
- SORT ; Sort surgeries by inverted date
- +1 NEW GMDT
- SET GMDT=$PIECE($GET(@(GMTSGL_GMN_",0)")),U,9)
- IF GMDT>GMTSBEG&(GMDT<GMTSEND)
- Begin DoDot:1
- +2 FOR
- if '$DATA(SURG(9999999-GMDT))
- QUIT
- SET GMDT=GMDT+.0001
- +3 SET SURG(9999999-GMDT)=GMN
- End DoDot:1
- +4 QUIT
- +5 ;
- WRT ; Write surgical case record
- +1 SET GMN=+($GET(GMN))
- +2 if +($$PROK^GMTSU("SROGMTS",100))>0
- DO HS^SROGMTS(GMN)
- +3 if +($$PROK^GMTSU("SROGMTS",100))'>0
- DO ONE^GMTSROE(GMN)
- +4 NEW X,Y,GMI,GMDT,GMTSTR
- +5 ;-------------------------------------------------------
- +6 if $GET(REC(130,GMN,118,"I"))'="Y"
- QUIT
- SET GMCOUNT=GMCOUNT+1
- NONOR ; NON-OR information
- SP ; Date/Specialty/Provider
- +1 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- +2 SET GMDT=$GET(REC(130,GMN,.09,"S"))
- if '$LENGTH(GMDT)
- SET GMDT=$$ED^GMTSU($GET(REC(130,GMN,.09,"I")))
- +3 SET GMTSTR=$GET(REC(130,GMN,125,"S"))
- if $LENGTH($GET(GMTSTR))>25
- SET GMTSTR=$$WRAP^GMTSORC(GMTSTR,25)
- +4 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- +5 WRITE GMDT,?21,$PIECE($GET(GMTSTR),"|"),?47,"Provider: ",?56,$GET(REC(130,GMN,123,"E")),!
- +6 FOR GMI=2:1:$LENGTH($GET(GMTSTR),"|")
- DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE ?23,$PIECE($GET(GMTSTR),"|",GMI),!
- +7 ;
- SA ; Status/Attending
- +1 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- +2 WRITE ?13,"Status:",?21,$GET(REC(130,GMN,"STATUS"))
- +3 WRITE ?46,"Attending: ",?56,$GET(REC(130,GMN,124,"E")),!
- PA ; Principal Anesthetist
- +1 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- +2 WRITE ?45,"Prin Anest: ",?56,$GET(REC(130,GMN,.31,"E")),!
- PD ; Principle Diagnosis
- +1 SET GMTSTR=$GET(REC(130,GMN,33,"S"))
- if '$LENGTH(GMTSTR)
- SET GMTSTR=$GET(REC(130,GMN,33,"E"))
- +2 if $LENGTH($GET(GMTSTR))>39
- SET GMTSTR=$$WRAP^GMTSORC(GMTSTR,39)
- +3 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE ?9,"Princ Diag: ",$PIECE($GET(GMTSTR),"|"),!
- +4 FOR GMI=2:1:$LENGTH($GET(GMTSTR),"|")
- DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE ?21,$PIECE($GET(GMTSTR),"|",GMI),!
- PP ; Principal Procedure
- +1 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE ?5,"Proc Performed: "
- +2 SET GMTSTR=$GET(REC(130,GMN,26,"S"))
- +3 if GMTSTR=""
- SET GMTSTR=$GET(REC(130,GMN,26,"E"))
- +4 if $LENGTH(GMTSTR)>58
- SET GMTSTR=$$WRAP^GMTSORC(GMTSTR,58)
- +5 FOR GMJ=1:1:$LENGTH(GMTSTR,"|")
- Begin DoDot:1
- +6 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE ?$SELECT(GMJ=1:21,1:22),$PIECE(GMTSTR,"|",GMJ),!
- End DoDot:1
- if $DATA(GMTSQIT)
- QUIT
- +7 if $DATA(GMTSQIT)
- QUIT
- PPM ; Principal Procedure (Modifiers)
- +1 SET GMI=0
- FOR
- SET GMI=$ORDER(REC(130,GMN,130.028,GMI))
- if GMI'>0
- QUIT
- Begin DoDot:1
- +2 SET GMTSTR=$GET(REC(130,GMN,130.028,GMI,.01,"S"))
- if GMTSTR=""
- SET GMTSTR=$GET(REC(130,GMN,130.028,GMI,.01,"E"))
- if $LENGTH(GMTSTR)>54
- SET GMTSTR=$$WRAP^GMTSORC(GMTSTR,54)
- +3 FOR GMJ=1:1:$LENGTH(GMTSTR,"|")
- Begin DoDot:2
- +4 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE ?$SELECT(GMJ=1:25,1:26),$PIECE(GMTSTR,"|",GMJ),!
- End DoDot:2
- if $DATA(GMTSQIT)
- QUIT
- End DoDot:1
- if $DATA(GMTSQIT)
- QUIT
- +5 if $DATA(GMTSQIT)
- QUIT
- OPP ; Other Procedure Performed
- +1 SET GMI=0
- FOR
- SET GMI=$ORDER(REC(130,GMN,130.16,GMI))
- if GMI'>0
- QUIT
- Begin DoDot:1
- +2 SET GMTSTR=$GET(REC(130,GMN,130.16,GMI,.01,"S"))
- if GMTSTR=""
- SET GMTSTR=$GET(REC(130,GMN,130.16,GMI,.01,"E"))
- if $LENGTH(GMTSTR)>58
- SET GMTSTR=$$WRAP^GMTSORC(GMTSTR,58)
- +3 FOR GMJ=1:1:$LENGTH(GMTSTR,"|")
- Begin DoDot:2
- +4 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- +5 WRITE ?$SELECT(GMJ=1:21,1:22),$PIECE(GMTSTR,"|",GMJ),!
- End DoDot:2
- if $DATA(GMTSQIT)
- QUIT
- OPPM ; Other Procedure Performed (Modifiers)
- +1 NEW GMM
- SET GMM=0
- +2 FOR
- SET GMM=$ORDER(REC(130,GMN,130.16,GMI,130.164,GMM))
- if +GMM=0
- QUIT
- Begin DoDot:2
- +3 SET GMTSTR=$GET(REC(130,GMN,130.16,GMI,130.164,GMM,.01,"S"))
- if '$LENGTH(GMTSTR)
- SET GMTSTR=$GET(REC(130,GMN,130.16,GMI,130.164,GMM,.01,"E"))
- if $LENGTH(GMTSTR)>54
- SET GMTSTR=$$WRAP^GMTSORC(GMTSTR,54)
- +4 FOR GMJ=1:1:$LENGTH(GMTSTR,"|")
- Begin DoDot:3
- +5 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE ?$SELECT(GMJ=1:25,1:26),$PIECE(GMTSTR,"|",GMJ),!
- End DoDot:3
- if $DATA(GMTSQIT)
- QUIT
- End DoDot:2
- +6 if $DATA(GMTSQIT)
- QUIT
- End DoDot:1
- +7 if $DATA(GMTSQIT)
- QUIT
- IND ; Indications for Surgery
- +1 IF $GET(REC(130,GMN,55,"S",0))>0
- Begin DoDot:1
- +2 NEW GMI,GMC
- SET (GMI,GMC)=0
- FOR
- SET GMI=$ORDER(REC(130,GMN,55,"S",GMI))
- if +GMI=0
- QUIT
- Begin DoDot:2
- +3 SET GMC=+GMC+1
- DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- if GMC=1
- WRITE "Indication for Proc:"
- WRITE ?21,$GET(REC(130,GMN,55,"S",GMI)),!
- End DoDot:2
- if $DATA(GMTSQIT)
- QUIT
- End DoDot:1
- if $DATA(GMTSQIT)
- QUIT
- FIND ; Findings
- +1 IF $GET(REC(130,GMN,59,"S",0))>0
- Begin DoDot:1
- +2 NEW GMI,GMC
- SET (GMI,GMC)=0
- FOR
- SET GMI=$ORDER(REC(130,GMN,59,"S",GMI))
- if +GMI=0
- QUIT
- Begin DoDot:2
- +3 SET GMC=+GMC+1
- DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- if GMC=1
- WRITE " Operative Findings:"
- WRITE ?21,$GET(REC(130,GMN,59,"S",GMI)),!
- End DoDot:2
- if $DATA(GMTSQIT)
- QUIT
- End DoDot:1
- if $DATA(GMTSQIT)
- QUIT
- DICT ; Dictation
- +1 IF $ORDER(REC(130,GMN,1.15,0))>0
- Begin DoDot:1
- +2 NEW GMI
- DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE "Surgeon's Dictation:",!
- +3 SET GMI=0
- FOR
- SET GMI=$ORDER(REC(130,GMN,1.15,GMI))
- if +GMI=0
- QUIT
- Begin DoDot:2
- +4 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE ?2,$GET(REC(130,GMN,1.15,GMI)),!
- End DoDot:2
- if $DATA(GMTSQIT)
- QUIT
- End DoDot:1
- +5 QUIT
- +6 ;--------------------------------------------------------------------
- CHK() ; For selected procedures see if you have a match
- +1 NEW GMTSI,GMTSF,GMTSC
- +2 ; p.106 $$GET1^DIQ call changed to file 136
- SET GMTSC=$$GET1^DIQ(136,+($GET(GMN)),.02,"I")
- if '$DATA(GMTSEG(GMTSEGN,81))
- QUIT 1
- +3 SET GMTSF=0
- FOR GMTSI=0:0
- SET GMTSI=$ORDER(GMTSEG(GMTSEGN,81,GMTSI))
- if '+GMTSI!GMTSF
- QUIT
- if GMTSEG(GMTSEGN,81,GMTSI)=GMTSC
- SET GMTSF=1
- if GMTSF
- QUIT
- +4 QUIT GMTSF
