- GMTSROE ; SLC/KER - Surgery Extract ; 06/24/2002 [7/28/04 8:40am]
- ;;2.7;Health Summary;**37,57,71**;Oct 20, 1995
- ;
- ; External References
- ; DBIA 2491 ^SRF( file #130
- ; DBIA 10103 $$HTFM^XLFDT
- ; DBIA 10015 EN^DIQ1
- ; DBIA 1996 $$CPT^ICPTCOD
- ; DBIA 10011 ^DIWP
- ; DBIA 2056 $$GET1^DIQ (file #81.3)
- ; DBIA 2056 $$GET1^DIQ (file #81)
- ; DBIA 2056 $$GET1^DIQ (file #130)
- ; DBIA 2052 FILE^DID
- ;
- Q
- ONE(X) ; Extract One Surgery Report
- K REC N GMTSCPTM,GMSG,DA,DR,DIC,DIQ,IEN,IENS,FILE,FLD,FLDS,FLDI
- N FLDA,FLDB,FLDR,FLDRT,IEN,GMTSI,GMTSRT,GMTST,GMTSS,GMTSC,GMTSCS
- S GMTSCPTM=+($$CPT^GMTSU(+($G(GMTSEGN)))) S:$G(GMPXCMOD)="N" GMTSCPTM=0
- Q:'$D(^SRF(X,0)) S (IENS,IEN,X)=+($G(X)),U="^"
- S:'$D(DT) DT=$$HTFM^XLFDT($H,1) S:'$D(DTIME) DTIME=300
- S (FILE,DIC)=130,DA=+($G(X)),DIQ="REC(",DIQ(0)="IE"
- S GMSG=$$SG(IEN),REC(130,IEN,118,"E")=$S(GMSG=0:"YES",1:""),REC(130,IEN,118,"I")=$S(GMSG=0:"Y",1:"")
- S:+GMSG DR=".09;.04;.14;.205;.22;.23;.31;1.15;10;15;17;26;27;32;34;36;39;43;49"
- S:'GMSG DR=".09;.31;26;27;33;55;59;66;1.15;121;122;123;124;125"
- D EN^DIQ1 S REC(130,IEN,"STATUS")=$$OS(IEN) S:+GMSG REC(130,IEN,"VERIFIED")=$S($G(REC(130,IEN,43,"I"))'="Y":"(Unverified)",1:"")
- S GMTSM=$G(REC(130,IEN,27,"I")) I GMTSM>0 D
- . S GMTSC=$$CPT^ICPTCOD(GMTSM),(GMTSCS,GMTSS)=$$EN2^GMTSUMX($P(GMTSC,"^",3))
- . S REC(130,IEN,27,"X")=$P(GMTSC,"^",2)_"^"_$P(GMTSC,"^",3)
- . S GMTSC=$P(GMTSC,"^",2),GMTST=$$EN2^GMTSUMX($G(REC(130,IEN,26,"E")))
- . S:$L(GMTSS)&(GMTSS'=GMTST) GMTST=GMTST_" - "_GMTSS
- . S:$L(GMTSC)=5 GMTST=GMTST_" (CPT "_GMTSC_")",GMTSCS=GMTSCS_" (CPT "_GMTSC_")"
- . S REC(130,IEN,27,"N")=GMTSS
- . S (REC(130,IEN,26,"S"),REC(130,IEN,27,"S"))=GMTST
- . S REC(130,IEN,27,"S")=GMTSCS
- D SUB
- S:$D(REC(130,IEN,32)) REC(130,IEN,32,"S")=$$EN2^GMTSUMX($G(REC(130,IEN,32,"E")))
- S:$D(REC(130,IEN,33)) REC(130,IEN,33,"S")=$$EN2^GMTSUMX($G(REC(130,IEN,33,"E")))
- S:$D(REC(130,IEN,34)) REC(130,IEN,34,"S")=$$EN2^GMTSUMX($G(REC(130,IEN,34,"E")))
- S:$D(REC(130,IEN,.04)) REC(130,IEN,.04,"S")=$$EN2^GMTSUMX($G(REC(130,IEN,.04,"E")))
- S:$D(REC(130,IEN,125)) REC(130,IEN,125,"S")=$$EN2^GMTSUMX($G(REC(130,IEN,125,"E")))
- I $L($G(REC(130,IEN,33,"S"))) D
- . S:'$L($G(REC(130,IEN,66,"E"))) REC(130,IEN,33,"S")=$G(REC(130,IEN,33,"S"))_" (Unknown)"
- . S:$L($G(REC(130,IEN,66,"E"))) REC(130,IEN,33,"S")=$G(REC(130,IEN,33,"S"))_" (ICD "_$G(REC(130,IEN,66,"E"))_")"
- S:+($G(REC(130,IEN,.09,"I")))>0 REC(130,IEN,.09,"S")=$$ED^GMTSU($G(REC(130,IEN,.09,"I")))
- S:+($G(REC(130,IEN,15,"I")))>0 REC(130,IEN,15,"S")=$$EDT^GMTSU($G(REC(130,IEN,15,"I")))
- S:+($G(REC(130,IEN,39,"I"))) REC(130,IEN,39,"S")=$$EDT^GMTSU($G(REC(130,IEN,39,"I")))
- S:+GMSG REC(130,IEN,"LAB")=$S($O(REC(130,IEN,49,0))>0:"Yes",1:"")
- I 'GMSG D:+($O(REC(130,IEN,55,0)))>0 WP(IEN,55,58) D:+($O(REC(130,IEN,59,0)))>0 WP(IEN,59,58)
- Q
- WP(X,Y,Z) ; Word Processing
- N GMTSI,GMTSF,GMTSW,GMI,DIWF,DIWL,DIWR
- S GMTSI=+($G(X)) Q:GMTSI=0!('$D(REC(130,GMTSI)))
- S GMTSF=+($G(Y)) Q:GMTSF=0!('$D(REC(130,GMTSI,GMTSF)))
- S GMTSW=+($G(Z)) Q:GMTSW'>0!(GMTSW>79)
- Q:+($O(REC(130,GMTSI,GMTSF,0)))'>0
- K ^UTILITY($J,"W") S DIWF="C"_GMTSW,DIWL=0,DIWR=0,GMI=0
- F S GMI=$O(REC(130,GMTSI,GMTSF,GMI)) Q:+GMI=0 D
- . S X=$G(REC(130,GMTSI,GMTSF,GMI)) D ^DIWP
- S GMI=0 F S GMI=$O(^UTILITY($J,"W",0,GMI)) Q:+GMI=0 D
- . S REC(130,GMTSI,GMTSF,"S",GMI)=$G(^UTILITY($J,"W",0,GMI,0))
- . S REC(130,GMTSI,GMTSF,"S",0)=$G(REC(130,GMTSI,GMTSF,"S",0))+1
- K ^UTILITY($J,"W")
- Q
- OS(X) ; Obtains status for OR procedures
- N GMN S GMN=+($G(X)) S X="" I $G(REC(130,GMN,118,"I"))="Y" D Q X
- . S:+($G(REC(130,GMN,122,"I")))>0 X="(Completed)"
- . S:+($G(REC(130,GMN,121,"I")))>0&(+($G(REC(130,GMN,122,"I")))'>0) X="Incomplete"
- . S:X="" X="Unknown"
- I +($G(REC(130,GMN,17,"I")))>0 D Q X
- . S X=$S(+($G(REC(130,GMN,.205,"I")))>0:"(Aborted)",1:"Cancelled")
- I +($G(REC(130,GMN,.23,"I")))>0 S X="(Completed)" Q X
- I +($G(REC(130,GMN,.22,"I")))>0 S X="Incomplete" Q X
- I +($G(REC(130,GMN,10,"I")))>0 S X="Scheduled" Q X
- I +($G(REC(130,GMN,36,"I")))>0,+($G(REC(130,GMN,.22,"I")))'>0 S X="Requested" Q X
- S X="Unknown"
- Q X
- SUB ; Surgery Subfiles
- N DA,DR,DIC,DIQ,IENS,FILE,FLD,FLDS,FLDI,FLDA,FLDB,FLDR,FLDRT,GMTSM,GMTSC,GMTSI,GMTSJ,STXT,SNAM,SCOD,SUB
- I +GMSG D
- . ; ^SRF(DO,14,I) .72
- . ; Other Preop Diagnosis 14;0 130.17
- . ; $P(^SRF(DO,14,I,0),U) .01
- . ; Other Preop Diagnosis 0;1 Text
- . S DA=IEN,(FILE,DIC)=130,SUB=130.17,DR=.72,DR(SUB)=".01",DIQ="REC(130,"_IEN_",",DIQ(0)="IE"
- . K REC(SUB) S GMTSI=0 F S GMTSI=$O(^SRF(+($G(IEN)),14,GMTSI)) Q:+GMTSI=0 D
- . . S DA(SUB)=GMTSI D EN^DIQ1
- . . S REC(130,IEN,130.17,GMTSI,.01,"S")=$$EN2^GMTSUMX($G(REC(130,IEN,130.17,GMTSI,.01,"E")))
- . ; ^SRF(DO,15,I) .74
- . ; Other Postop Diagnosis 15;0 130.18
- . ; $P(^SRF(DO,15,I,0),U) .01
- . ; Other Postop Diagnosis 0;1 Text
- . S DA=IEN,(FILE,DIC)=130,SUB=130.18,DR=.74,DR(SUB)=".01",DIQ="REC(130,"_IEN_",",DIQ(0)="IE"
- . K REC(SUB) S GMTSI=0 F S GMTSI=$O(^SRF(+($G(IEN)),15,GMTSI)) Q:+GMTSI=0 D
- . . S DA(SUB)=GMTSI D EN^DIQ1
- . . S REC(130,IEN,130.18,GMTSI,.01,"S")=$$EN2^GMTSUMX($G(REC(130,IEN,130.18,GMTSI,.01,"E")))
- ; ^SRF(GMN,"OPMOD",I) 28
- ; Primary Proc CPT Mod OPMOD;0 130.028
- ; $P(^SRF(GMN,"OPMOD",I,0),U) .01
- ; Primary Proc CPT Mod 0;1 Ptr 81.3
- I GMTSCPTM D
- . S DA=IEN,(FILE,DIC)=130,SUB=130.028,DR=28,DR(SUB)=".01",DIQ="REC(130,"_IEN_",",DIQ(0)="IE"
- . K REC(SUB) S GMTSI=0 F S GMTSI=$O(^SRF(+($G(IEN)),"OPMOD",GMTSI)) Q:+GMTSI=0 D
- . . S DA(SUB)=GMTSI D EN^DIQ1
- . . S GMTSM=+($G(REC(130,+($G(IEN)),SUB,+($G(GMTSI)),.01,"I")))
- . . I GMTSM>0 D
- . . . N GMTSMOD S GMTSMOD=$$MOD^ICPTMOD(+GMTSM)
- . . . S GMTSC=$P(GMTSMOD,"^",2)
- . . . S GMTSS=$P(GMTSMOD,"^",3)
- . . . S REC(130,IEN,SUB,GMTSI,.01,"MID")=GMTSC
- . . . S REC(130,IEN,SUB,GMTSI,.01,"MOD")=GMTSS
- . . . S GMTST=$$EN2^GMTSUMX(GMTSS)
- . . . S:$L(GMTSC) GMTST=GMTST_" (CPT Mod "_GMTSC_")"
- . . . S REC(130,IEN,SUB,GMTSI,.01,"S")=GMTST
- ; ^SRF(DO,13,I) .42
- ; Other Proc 13;0 130.16
- ; $P(^SRF(DO,13,I,0),U) .01
- ; Other Proc 0;1 Text
- ; $P(^SRF(DO,13,I,2),U) 3
- ; Other Proc CPT Code 2;1 Ptr 81
- S DA=IEN,(FILE,DIC)=130,SUB=130.16,DR=.42,DR(SUB)=".01;3",DIQ="REC(130,"_IEN_",",DIQ(0)="IE"
- K REC(SUB) S GMTSI=0 F S GMTSI=$O(^SRF(+($G(IEN)),13,GMTSI)) Q:+GMTSI=0 D
- . N GMTSCPT S DA(SUB)=GMTSI
- . D EN^DIQ1 S GMTSM=+($G(REC(130,IEN,130.16,GMTSI,3,"I")))
- . S GMTSCPT=$$CPT^ICPTCOD(+GMTSM)
- . S:GMTSM>0 REC(130,IEN,130.16,GMTSI,3,"N")=$P(GMTSCPT,"^",3)
- . N GMTST,GMTSS,GMTSC S GMTSM=$G(REC(130,IEN,130.16,GMTSI,3,"I")) I GMTSM>0 D
- . . S GMTSC=$$CPT^ICPTCOD(GMTSM),(GMTSCS,GMTSS)=$$EN2^GMTSUMX($P(GMTSC,"^",3))
- . . S REC(130,IEN,130.16,GMTSI,3,"X")=$P(GMTSC,"^",2)_"^"_$P(GMTSC,"^",3)
- . . S GMTSC=$P(GMTSC,"^",2)
- . . S GMTST=$$EN2^GMTSUMX($G(REC(130,IEN,130.16,GMTSI,.01,"E")))
- . . S:$L(GMTSS)&(GMTSS'=GMTST) GMTST=GMTST_" - "_$$EN2^GMTSUMX(GMTSS)
- . . S:$L(GMTSC)=5 GMTST=GMTST_" (CPT "_GMTSC_")",GMTSCS=GMTSCS_" (CPT "_GMTSC_")"
- . . S REC(130,IEN,130.16,GMTSI,3,"N")=GMTSS
- . . S REC(130,IEN,130.16,GMTSI,.01,"S")=GMTST
- . . S REC(130,IEN,130.16,GMTSI,3,"S")=GMTSCS
- . ; ^SRF(8,13,2,"MOD",0) 4
- . ; Oth Proc CPT Mod MOD;0 130.164
- . ; ^SRF(8,13,2,"MOD",1,0) .01
- . ; Oth Proc CPT Mod 0;1 Ptr 81.3
- . I GMTSCPTM D
- . . N GMTSJ S GMTSJ=0 F S GMTSJ=$O(^SRF(+($G(IEN)),13,GMTSI,"MOD",GMTSJ)) Q:+GMTSJ=0 D
- . . . N DA,FILE,DIC,SUB,DR,DIQ S DA=IEN,DR=.42,FILE=130,SUB=130.16,DR(SUB)="4",DA(SUB)=GMTSI,SUB=130.164,DR(SUB)=".01",DA(SUB)=GMTSJ,DIC=130,DIQ="REC(130,"_IEN_",130.16,"_GMTSI_",",DIQ(0)="IE"
- . . . D EN^DIQ1
- . . . S GMTSM=+($G(REC(130,IEN,130.16,GMTSI,130.164,GMTSJ,.01,"I")))
- . . . I GMTSM>0 D
- . . . . N GMTSMOD S GMTSMOD=$$MOD^ICPTMOD(+GMTSM)
- . . . . S GMTSC=$P(GMTSMOD,"^",2)
- . . . . S GMTSS=$P(GMTSMOD,"^",3)
- . . . . S REC(130,IEN,130.16,GMTSI,SUB,GMTSJ,.01,"MID")=GMTSC
- . . . . S REC(130,IEN,130.16,GMTSI,SUB,GMTSJ,.01,"MOD")=GMTSS
- . . . . S REC(130,IEN,130.16,GMTSI,SUB,GMTSJ,.01,"X")=GMTSC_"^"_GMTSS
- . . . . S GMTST=$$EN2^GMTSUMX(GMTSS) S:$L(GMTSC) GMTST=GMTST_" (CPT Mod "_GMTSC_")"
- . . . . S REC(130,IEN,130.16,GMTSI,SUB,GMTSJ,.01,"S")=GMTST
- . . . K REC(130,IEN,130.16,GMTSI,130)
- Q
- SORT ; Sort surgeries by inverted date
- N GMDT S GMDT=$P(^SRF(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
- GL(X) ; Global Location
- N FIL D FILE^DID(130,"N","GLOBAL NAME","FIL","FIL(""ERR"")") S X=$G(FIL("GLOBAL NAME"))
- S:$E(X,1)'="^"!($E(X,2,$L(X))["^")!($L($E(X,2,$L(X)))<2)!($L($E(X,2,$L(X)))>8)!($E(X,2,$L(X))'["(") X=""
- I $L(X) S:'$D(@($P(X,"(",1))) X=""
- Q X
- SG(X) ; Surgical (Operative) Record
- S X=$$GET1^DIQ(130,+($G(X)),118,"I") S X=$S(X["Y":0,1:1) Q X
- GMTSROE ; SLC/KER - Surgery Extract ; 06/24/2002 [7/28/04 8:40am]
- +1 ;;2.7;Health Summary;**37,57,71**;Oct 20, 1995
- +2 ;
- +3 ; External References
- +4 ; DBIA 2491 ^SRF( file #130
- +5 ; DBIA 10103 $$HTFM^XLFDT
- +6 ; DBIA 10015 EN^DIQ1
- +7 ; DBIA 1996 $$CPT^ICPTCOD
- +8 ; DBIA 10011 ^DIWP
- +9 ; DBIA 2056 $$GET1^DIQ (file #81.3)
- +10 ; DBIA 2056 $$GET1^DIQ (file #81)
- +11 ; DBIA 2056 $$GET1^DIQ (file #130)
- +12 ; DBIA 2052 FILE^DID
- +13 ;
- +14 QUIT
- ONE(X) ; Extract One Surgery Report
- +1 KILL REC
- NEW GMTSCPTM,GMSG,DA,DR,DIC,DIQ,IEN,IENS,FILE,FLD,FLDS,FLDI
- +2 NEW FLDA,FLDB,FLDR,FLDRT,IEN,GMTSI,GMTSRT,GMTST,GMTSS,GMTSC,GMTSCS
- +3 SET GMTSCPTM=+($$CPT^GMTSU(+($GET(GMTSEGN))))
- IF $GET(GMPXCMOD)="N"
- SET GMTSCPTM=0
- +4 IF '$DATA(^SRF(X,0))
- QUIT
- SET (IENS,IEN,X)=+($GET(X))
- SET U="^"
- +5 IF '$DATA(DT)
- SET DT=$$HTFM^XLFDT($HOROLOG,1)
- IF '$DATA(DTIME)
- SET DTIME=300
- +6 SET (FILE,DIC)=130
- SET DA=+($GET(X))
- SET DIQ="REC("
- SET DIQ(0)="IE"
- +7 SET GMSG=$$SG(IEN)
- SET REC(130,IEN,118,"E")=$SELECT(GMSG=0:"YES",1:"")
- SET REC(130,IEN,118,"I")=$SELECT(GMSG=0:"Y",1:"")
- +8 IF +GMSG
- SET DR=".09;.04;.14;.205;.22;.23;.31;1.15;10;15;17;26;27;32;34;36;39;43;49"
- +9 IF 'GMSG
- SET DR=".09;.31;26;27;33;55;59;66;1.15;121;122;123;124;125"
- +10 DO EN^DIQ1
- SET REC(130,IEN,"STATUS")=$$OS(IEN)
- IF +GMSG
- SET REC(130,IEN,"VERIFIED")=$SELECT($GET(REC(130,IEN,43,"I"))'="Y":"(Unverified)",1:"")
- +11 SET GMTSM=$GET(REC(130,IEN,27,"I"))
- IF GMTSM>0
- Begin DoDot:1
- +12 SET GMTSC=$$CPT^ICPTCOD(GMTSM)
- SET (GMTSCS,GMTSS)=$$EN2^GMTSUMX($PIECE(GMTSC,"^",3))
- +13 SET REC(130,IEN,27,"X")=$PIECE(GMTSC,"^",2)_"^"_$PIECE(GMTSC,"^",3)
- +14 SET GMTSC=$PIECE(GMTSC,"^",2)
- SET GMTST=$$EN2^GMTSUMX($GET(REC(130,IEN,26,"E")))
- +15 IF $LENGTH(GMTSS)&(GMTSS'=GMTST)
- SET GMTST=GMTST_" - "_GMTSS
- +16 IF $LENGTH(GMTSC)=5
- SET GMTST=GMTST_" (CPT "_GMTSC_")"
- SET GMTSCS=GMTSCS_" (CPT "_GMTSC_")"
- +17 SET REC(130,IEN,27,"N")=GMTSS
- +18 SET (REC(130,IEN,26,"S"),REC(130,IEN,27,"S"))=GMTST
- +19 SET REC(130,IEN,27,"S")=GMTSCS
- End DoDot:1
- +20 DO SUB
- +21 IF $DATA(REC(130,IEN,32))
- SET REC(130,IEN,32,"S")=$$EN2^GMTSUMX($GET(REC(130,IEN,32,"E")))
- +22 IF $DATA(REC(130,IEN,33))
- SET REC(130,IEN,33,"S")=$$EN2^GMTSUMX($GET(REC(130,IEN,33,"E")))
- +23 IF $DATA(REC(130,IEN,34))
- SET REC(130,IEN,34,"S")=$$EN2^GMTSUMX($GET(REC(130,IEN,34,"E")))
- +24 IF $DATA(REC(130,IEN,.04))
- SET REC(130,IEN,.04,"S")=$$EN2^GMTSUMX($GET(REC(130,IEN,.04,"E")))
- +25 IF $DATA(REC(130,IEN,125))
- SET REC(130,IEN,125,"S")=$$EN2^GMTSUMX($GET(REC(130,IEN,125,"E")))
- +26 IF $LENGTH($GET(REC(130,IEN,33,"S")))
- Begin DoDot:1
- +27 IF '$LENGTH($GET(REC(130,IEN,66,"E")))
- SET REC(130,IEN,33,"S")=$GET(REC(130,IEN,33,"S"))_" (Unknown)"
- +28 IF $LENGTH($GET(REC(130,IEN,66,"E")))
- SET REC(130,IEN,33,"S")=$GET(REC(130,IEN,33,"S"))_" (ICD "_$GET(REC(130,IEN,66,"E"))_")"
- End DoDot:1
- +29 IF +($GET(REC(130,IEN,.09,"I")))>0
- SET REC(130,IEN,.09,"S")=$$ED^GMTSU($GET(REC(130,IEN,.09,"I")))
- +30 IF +($GET(REC(130,IEN,15,"I")))>0
- SET REC(130,IEN,15,"S")=$$EDT^GMTSU($GET(REC(130,IEN,15,"I")))
- +31 IF +($GET(REC(130,IEN,39,"I")))
- SET REC(130,IEN,39,"S")=$$EDT^GMTSU($GET(REC(130,IEN,39,"I")))
- +32 IF +GMSG
- SET REC(130,IEN,"LAB")=$SELECT($ORDER(REC(130,IEN,49,0))>0:"Yes",1:"")
- +33 IF 'GMSG
- IF +($ORDER(REC(130,IEN,55,0)))>0
- DO WP(IEN,55,58)
- IF +($ORDER(REC(130,IEN,59,0)))>0
- DO WP(IEN,59,58)
- +34 QUIT
- WP(X,Y,Z) ; Word Processing
- +1 NEW GMTSI,GMTSF,GMTSW,GMI,DIWF,DIWL,DIWR
- +2 SET GMTSI=+($GET(X))
- IF GMTSI=0!('$DATA(REC(130,GMTSI)))
- QUIT
- +3 SET GMTSF=+($GET(Y))
- IF GMTSF=0!('$DATA(REC(130,GMTSI,GMTSF)))
- QUIT
- +4 SET GMTSW=+($GET(Z))
- IF GMTSW'>0!(GMTSW>79)
- QUIT
- +5 IF +($ORDER(REC(130,GMTSI,GMTSF,0)))'>0
- QUIT
- +6 KILL ^UTILITY($JOB,"W")
- SET DIWF="C"_GMTSW
- SET DIWL=0
- SET DIWR=0
- SET GMI=0
- +7 FOR
- SET GMI=$ORDER(REC(130,GMTSI,GMTSF,GMI))
- IF +GMI=0
- QUIT
- Begin DoDot:1
- +8 SET X=$GET(REC(130,GMTSI,GMTSF,GMI))
- DO ^DIWP
- End DoDot:1
- +9 SET GMI=0
- FOR
- SET GMI=$ORDER(^UTILITY($JOB,"W",0,GMI))
- IF +GMI=0
- QUIT
- Begin DoDot:1
- +10 SET REC(130,GMTSI,GMTSF,"S",GMI)=$GET(^UTILITY($JOB,"W",0,GMI,0))
- +11 SET REC(130,GMTSI,GMTSF,"S",0)=$GET(REC(130,GMTSI,GMTSF,"S",0))+1
- End DoDot:1
- +12 KILL ^UTILITY($JOB,"W")
- +13 QUIT
- OS(X) ; Obtains status for OR procedures
- +1 NEW GMN
- SET GMN=+($GET(X))
- SET X=""
- IF $GET(REC(130,GMN,118,"I"))="Y"
- Begin DoDot:1
- +2 IF +($GET(REC(130,GMN,122,"I")))>0
- SET X="(Completed)"
- +3 IF +($GET(REC(130,GMN,121,"I")))>0&(+($GET(REC(130,GMN,122,"I")))'>0)
- SET X="Incomplete"
- +4 IF X=""
- SET X="Unknown"
- End DoDot:1
- QUIT X
- +5 IF +($GET(REC(130,GMN,17,"I")))>0
- Begin DoDot:1
- +6 SET X=$SELECT(+($GET(REC(130,GMN,.205,"I")))>0:"(Aborted)",1:"Cancelled")
- End DoDot:1
- QUIT X
- +7 IF +($GET(REC(130,GMN,.23,"I")))>0
- SET X="(Completed)"
- QUIT X
- +8 IF +($GET(REC(130,GMN,.22,"I")))>0
- SET X="Incomplete"
- QUIT X
- +9 IF +($GET(REC(130,GMN,10,"I")))>0
- SET X="Scheduled"
- QUIT X
- +10 IF +($GET(REC(130,GMN,36,"I")))>0
- IF +($GET(REC(130,GMN,.22,"I")))'>0
- SET X="Requested"
- QUIT X
- +11 SET X="Unknown"
- +12 QUIT X
- SUB ; Surgery Subfiles
- +1 NEW DA,DR,DIC,DIQ,IENS,FILE,FLD,FLDS,FLDI,FLDA,FLDB,FLDR,FLDRT,GMTSM,GMTSC,GMTSI,GMTSJ,STXT,SNAM,SCOD,SUB
- +2 IF +GMSG
- Begin DoDot:1
- +3 ; ^SRF(DO,14,I) .72
- +4 ; Other Preop Diagnosis 14;0 130.17
- +5 ; $P(^SRF(DO,14,I,0),U) .01
- +6 ; Other Preop Diagnosis 0;1 Text
- +7 SET DA=IEN
- SET (FILE,DIC)=130
- SET SUB=130.17
- SET DR=.72
- SET DR(SUB)=".01"
- SET DIQ="REC(130,"_IEN_","
- SET DIQ(0)="IE"
- +8 KILL REC(SUB)
- SET GMTSI=0
- FOR
- SET GMTSI=$ORDER(^SRF(+($GET(IEN)),14,GMTSI))
- IF +GMTSI=0
- QUIT
- Begin DoDot:2
- +9 SET DA(SUB)=GMTSI
- DO EN^DIQ1
- +10 SET REC(130,IEN,130.17,GMTSI,.01,"S")=$$EN2^GMTSUMX($GET(REC(130,IEN,130.17,GMTSI,.01,"E")))
- End DoDot:2
- +11 ; ^SRF(DO,15,I) .74
- +12 ; Other Postop Diagnosis 15;0 130.18
- +13 ; $P(^SRF(DO,15,I,0),U) .01
- +14 ; Other Postop Diagnosis 0;1 Text
- +15 SET DA=IEN
- SET (FILE,DIC)=130
- SET SUB=130.18
- SET DR=.74
- SET DR(SUB)=".01"
- SET DIQ="REC(130,"_IEN_","
- SET DIQ(0)="IE"
- +16 KILL REC(SUB)
- SET GMTSI=0
- FOR
- SET GMTSI=$ORDER(^SRF(+($GET(IEN)),15,GMTSI))
- IF +GMTSI=0
- QUIT
- Begin DoDot:2
- +17 SET DA(SUB)=GMTSI
- DO EN^DIQ1
- +18 SET REC(130,IEN,130.18,GMTSI,.01,"S")=$$EN2^GMTSUMX($GET(REC(130,IEN,130.18,GMTSI,.01,"E")))
- End DoDot:2
- End DoDot:1
- +19 ; ^SRF(GMN,"OPMOD",I) 28
- +20 ; Primary Proc CPT Mod OPMOD;0 130.028
- +21 ; $P(^SRF(GMN,"OPMOD",I,0),U) .01
- +22 ; Primary Proc CPT Mod 0;1 Ptr 81.3
- +23 IF GMTSCPTM
- Begin DoDot:1
- +24 SET DA=IEN
- SET (FILE,DIC)=130
- SET SUB=130.028
- SET DR=28
- SET DR(SUB)=".01"
- SET DIQ="REC(130,"_IEN_","
- SET DIQ(0)="IE"
- +25 KILL REC(SUB)
- SET GMTSI=0
- FOR
- SET GMTSI=$ORDER(^SRF(+($GET(IEN)),"OPMOD",GMTSI))
- IF +GMTSI=0
- QUIT
- Begin DoDot:2
- +26 SET DA(SUB)=GMTSI
- DO EN^DIQ1
- +27 SET GMTSM=+($GET(REC(130,+($GET(IEN)),SUB,+($GET(GMTSI)),.01,"I")))
- +28 IF GMTSM>0
- Begin DoDot:3
- +29 NEW GMTSMOD
- SET GMTSMOD=$$MOD^ICPTMOD(+GMTSM)
- +30 SET GMTSC=$PIECE(GMTSMOD,"^",2)
- +31 SET GMTSS=$PIECE(GMTSMOD,"^",3)
- +32 SET REC(130,IEN,SUB,GMTSI,.01,"MID")=GMTSC
- +33 SET REC(130,IEN,SUB,GMTSI,.01,"MOD")=GMTSS
- +34 SET GMTST=$$EN2^GMTSUMX(GMTSS)
- +35 IF $LENGTH(GMTSC)
- SET GMTST=GMTST_" (CPT Mod "_GMTSC_")"
- +36 SET REC(130,IEN,SUB,GMTSI,.01,"S")=GMTST
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +37 ; ^SRF(DO,13,I) .42
- +38 ; Other Proc 13;0 130.16
- +39 ; $P(^SRF(DO,13,I,0),U) .01
- +40 ; Other Proc 0;1 Text
- +41 ; $P(^SRF(DO,13,I,2),U) 3
- +42 ; Other Proc CPT Code 2;1 Ptr 81
- +43 SET DA=IEN
- SET (FILE,DIC)=130
- SET SUB=130.16
- SET DR=.42
- SET DR(SUB)=".01;3"
- SET DIQ="REC(130,"_IEN_","
- SET DIQ(0)="IE"
- +44 KILL REC(SUB)
- SET GMTSI=0
- FOR
- SET GMTSI=$ORDER(^SRF(+($GET(IEN)),13,GMTSI))
- IF +GMTSI=0
- QUIT
- Begin DoDot:1
- +45 NEW GMTSCPT
- SET DA(SUB)=GMTSI
- +46 DO EN^DIQ1
- SET GMTSM=+($GET(REC(130,IEN,130.16,GMTSI,3,"I")))
- +47 SET GMTSCPT=$$CPT^ICPTCOD(+GMTSM)
- +48 IF GMTSM>0
- SET REC(130,IEN,130.16,GMTSI,3,"N")=$PIECE(GMTSCPT,"^",3)
- +49 NEW GMTST,GMTSS,GMTSC
- SET GMTSM=$GET(REC(130,IEN,130.16,GMTSI,3,"I"))
- IF GMTSM>0
- Begin DoDot:2
- +50 SET GMTSC=$$CPT^ICPTCOD(GMTSM)
- SET (GMTSCS,GMTSS)=$$EN2^GMTSUMX($PIECE(GMTSC,"^",3))
- +51 SET REC(130,IEN,130.16,GMTSI,3,"X")=$PIECE(GMTSC,"^",2)_"^"_$PIECE(GMTSC,"^",3)
- +52 SET GMTSC=$PIECE(GMTSC,"^",2)
- +53 SET GMTST=$$EN2^GMTSUMX($GET(REC(130,IEN,130.16,GMTSI,.01,"E")))
- +54 IF $LENGTH(GMTSS)&(GMTSS'=GMTST)
- SET GMTST=GMTST_" - "_$$EN2^GMTSUMX(GMTSS)
- +55 IF $LENGTH(GMTSC)=5
- SET GMTST=GMTST_" (CPT "_GMTSC_")"
- SET GMTSCS=GMTSCS_" (CPT "_GMTSC_")"
- +56 SET REC(130,IEN,130.16,GMTSI,3,"N")=GMTSS
- +57 SET REC(130,IEN,130.16,GMTSI,.01,"S")=GMTST
- +58 SET REC(130,IEN,130.16,GMTSI,3,"S")=GMTSCS
- End DoDot:2
- +59 ; ^SRF(8,13,2,"MOD",0) 4
- +60 ; Oth Proc CPT Mod MOD;0 130.164
- +61 ; ^SRF(8,13,2,"MOD",1,0) .01
- +62 ; Oth Proc CPT Mod 0;1 Ptr 81.3
- +63 IF GMTSCPTM
- Begin DoDot:2
- +64 NEW GMTSJ
- SET GMTSJ=0
- FOR
- SET GMTSJ=$ORDER(^SRF(+($GET(IEN)),13,GMTSI,"MOD",GMTSJ))
- IF +GMTSJ=0
- QUIT
- Begin DoDot:3
- +65 NEW DA,FILE,DIC,SUB,DR,DIQ
- SET DA=IEN
- SET DR=.42
- SET FILE=130
- SET SUB=130.16
- SET DR(SUB)="4"
- SET DA(SUB)=GMTSI
- SET SUB=130.164
- SET DR(SUB)=".01"
- SET DA(SUB)=GMTSJ
- SET DIC=130
- SET DIQ="REC(130,"_IEN_",130.16,"_GMTSI_","
- SET DIQ(0)="IE"
- +66 DO EN^DIQ1
- +67 SET GMTSM=+($GET(REC(130,IEN,130.16,GMTSI,130.164,GMTSJ,.01,"I")))
- +68 IF GMTSM>0
- Begin DoDot:4
- +69 NEW GMTSMOD
- SET GMTSMOD=$$MOD^ICPTMOD(+GMTSM)
- +70 SET GMTSC=$PIECE(GMTSMOD,"^",2)
- +71 SET GMTSS=$PIECE(GMTSMOD,"^",3)
- +72 SET REC(130,IEN,130.16,GMTSI,SUB,GMTSJ,.01,"MID")=GMTSC
- +73 SET REC(130,IEN,130.16,GMTSI,SUB,GMTSJ,.01,"MOD")=GMTSS
- +74 SET REC(130,IEN,130.16,GMTSI,SUB,GMTSJ,.01,"X")=GMTSC_"^"_GMTSS
- +75 SET GMTST=$$EN2^GMTSUMX(GMTSS)
- IF $LENGTH(GMTSC)
- SET GMTST=GMTST_" (CPT Mod "_GMTSC_")"
- +76 SET REC(130,IEN,130.16,GMTSI,SUB,GMTSJ,.01,"S")=GMTST
- End DoDot:4
- +77 KILL REC(130,IEN,130.16,GMTSI,130)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +78 QUIT
- SORT ; Sort surgeries by inverted date
- +1 NEW GMDT
- SET GMDT=$PIECE(^SRF(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
- GL(X) ; Global Location
- +1 NEW FIL
- DO FILE^DID(130,"N","GLOBAL NAME","FIL","FIL(""ERR"")")
- SET X=$GET(FIL("GLOBAL NAME"))
- +2 IF $EXTRACT(X,1)'="^"!($EXTRACT(X,2,$LENGTH(X))["^")!($LENGTH($EXTRACT(X,2,$LENGTH(X)))<2)!($LENGTH($EXTRACT(X,2,$LENGTH(X)))>8)!($EXTRACT(X,2,$LENGTH(X))'["(")
- SET X=""
- +3 IF $LENGTH(X)
- IF '$DATA(@($PIECE(X,"(",1)))
- SET X=""
- +4 QUIT X
- SG(X) ; Surgical (Operative) Record
- +1 SET X=$$GET1^DIQ(130,+($GET(X)),118,"I")
- SET X=$SELECT(X["Y":0,1:1)
- QUIT X
