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 Oct 16, 2024@18:01:03 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
