GMTSRASP ; SLC/JER,KER - Selected Radiology ; 01/06/2003
;;2.7;Health Summary;**28,37,58**;Oct 20, 1995
;
MAIN ; Controls branching
Q:+($G(DFN))=0 Q:+($G(DFN))'=+($$RP(+($G(DFN))))
N GMTSI,GMW,MAX,GMTSTEST,GMDATA
S MAX=$S(+$G(GMTSNDM)>0:GMTSNDM,1:999)
I '$O(GMTSEG(GMTSEGN,71,0)) Q
S GMTSI=0 F S GMTSI=$O(GMTSEG(GMTSEGN,71,GMTSI)) Q:GMTSI'>0 D
. S GMTSTEST=GMTSEG(GMTSEGN,71,GMTSI)
. D MAINSEL^GMTSRAE(1,GMTSTEST),LOOP:$D(^TMP("RAE",$J))
K ^TMP("RAE",$J)
Q
LOOP ; Loops through ^TMP("RAE",$J,
N GMW,GMTSIDT,GMTSPN,GMLN
S GMTSIDT=0 F S GMTSIDT=$O(^TMP("RAE",$J,GMTSIDT)) Q:GMTSIDT'>0 D Q:$D(GMTSQIT)
. S GMTSPN=0 F S GMTSPN=$O(^(GMTSIDT,GMTSPN)) Q:GMTSPN'>0 D WRT Q:$D(GMTSQIT)
Q
WRT ; Writes component data
Q:$D(GMTSQIT) N X,GMTSEDT S GMDATA=1,X=+^TMP("RAE",$J,GMTSIDT,GMTSPN,0) D REGDT4^GMTSU S GMTSEDT=X
D HD S GMTSPC=+($G(GMTSCP))+1 Q:$D(GMTSQIT) D HD Q:$D(GMTSQIT)
D CKP^GMTSUP Q:$D(GMTSQIT) W GMTSEDT D PRO,CMD,IMP Q
Q
PRO ; Procedure
N GMTSPRO,GMTSTA,GMTSEXS,GMTSCN,GMTSCPT,GMTSI
S GMTSPRO=$P(^TMP("RAE",$J,GMTSIDT,GMTSPN,0),"^",2),GMTSTA=$P(^(0),"^",4)
S GMTSTA=$S(GMTSTA="RELEASED/NOT VERIFIED":"REL/NOT VER",GMTSTA="PROBLEM DRAFT":"PROB DRAFT",1:GMTSTA)
S GMTSCPT=$P(^(0),"^",7),GMTSEXS=$P(^(0),"^",3),GMTSCN=$P(^(0),"^",9)
S:'$L(GMTSTA)&(GMTSEXS="CANCELLED") GMTSTA=GMTSEXS
S:'$L(GMTSTA) GMTSTA="PENDING" S GMTSTA=$$EN2^GMTSUMX(GMTSTA)
I $L(GMTSPRO)>35 S GMTSPRO=$$WRAP^GMTSORC(GMTSPRO,31)
D CKP^GMTSUP Q:$D(GMTSQIT) W ?12,$P(GMTSPRO,"|"),?46,GMTSCPT,?52,$E(GMTSTA,1,17),?64,GMTSCN,!
F GMTSI=2:1:$L(GMTSPRO,"|") D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(GMTSPRO,"|",GMTSI)]"" ?23,$P(GMTSPRO,"|",GMTSI),!
Q
CMD ; CPT Modifiers
;
; Quit - CPT Modifiers will not be used with
; Radiology Impression (RI) and Radiology
; Impression Selected (SRI) at this time
Q
N GMTSCPTM
S GMTSCPTM=+($$CPT^GMTSU(+($G(GMTSEGN)))) S:$G(GMPXCMOD)="N" GMTSCPTM=0
Q:'GMTSCPTM
N GMTSC,GMTSCM,GMTSCT,GMTSI S GMTSC=0 F S GMTSC=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)) Q:+GMTSC=0 D
. S GMTSCM=$P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",1)
. Q:'$L(GMTSCM) S GMTSCT=$P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",3) Q:'$L(GMTSCT)
. S GMTSCT=GMTSCT_" (CPT Mod "_GMTSCM_")" S:$L(GMTSCT)>35 GMTSCT=$$WRAP^GMTSORC(GMTSCT,62) D CKP^GMTSUP Q:$D(GMTSQIT) W ?14,$P(GMTSCT,"|"),!
. F GMTSI=2:1:$L(GMTSCT,"|") D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(GMTSCT,"|",GMTSI)]"" ?16,$P(GMTSCT,"|",GMTSI),!
Q
IMP ; Impression
Q:$D(GMTSQIT) N GMTSI,GMTST,DIWF,DIWL,DIWR
S GMTST=12 Q:'$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,"I")) K ^UTILITY($J,"W")
S DIWF="C"_(78-GMTST),DIWL=0,DIWR=0,GMTSI=0
F S GMTSI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"I",GMTSI)) Q:+GMTSI=0 D Q:$D(GMTSQIT)
. S X=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"I",GMTSI))
. ; DBIA 10011 call ^DIWP
. D ^DIWP
S GMTSI=0 F S GMTSI=$O(^UTILITY($J,"W",0,GMTSI)) Q:+GMTSI=0 D Q:$D(GMTSQIT)
. D CKP^GMTSUP Q:$D(GMTSQIT) W ?GMTST,$G(^UTILITY($J,"W",0,GMTSI,0)),!
K ^UTILITY($J,"W")
Q
HD ; Header/Page Check
Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT) Q:+($G(GMTSNPG))=0&(+($G(GMTSPC))>0)
W "Date",?12,"Procedure",?46,"CPT",?52,"Status",?64,"Case #",!
Q
RP(X) ; Radiology Patient
N Y S X=+($G(X))
; DBIA 2056 call $$GET1^DIQ
S Y=$$GET1^DIQ(70,X,.01,"I") S X=Y Q X
GMTSRASP ; SLC/JER,KER - Selected Radiology ; 01/06/2003
+1 ;;2.7;Health Summary;**28,37,58**;Oct 20, 1995
+2 ;
MAIN ; Controls branching
+1 IF +($GET(DFN))=0
QUIT
IF +($GET(DFN))'=+($$RP(+($GET(DFN))))
QUIT
+2 NEW GMTSI,GMW,MAX,GMTSTEST,GMDATA
+3 SET MAX=$SELECT(+$GET(GMTSNDM)>0:GMTSNDM,1:999)
+4 IF '$ORDER(GMTSEG(GMTSEGN,71,0))
QUIT
+5 SET GMTSI=0
FOR
SET GMTSI=$ORDER(GMTSEG(GMTSEGN,71,GMTSI))
IF GMTSI'>0
QUIT
Begin DoDot:1
+6 SET GMTSTEST=GMTSEG(GMTSEGN,71,GMTSI)
+7 DO MAINSEL^GMTSRAE(1,GMTSTEST)
IF $DATA(^TMP("RAE",$JOB))
DO LOOP
End DoDot:1
+8 KILL ^TMP("RAE",$JOB)
+9 QUIT
LOOP ; Loops through ^TMP("RAE",$J,
+1 NEW GMW,GMTSIDT,GMTSPN,GMLN
+2 SET GMTSIDT=0
FOR
SET GMTSIDT=$ORDER(^TMP("RAE",$JOB,GMTSIDT))
IF GMTSIDT'>0
QUIT
Begin DoDot:1
+3 SET GMTSPN=0
FOR
SET GMTSPN=$ORDER(^(GMTSIDT,GMTSPN))
IF GMTSPN'>0
QUIT
DO WRT
IF $DATA(GMTSQIT)
QUIT
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+4 QUIT
WRT ; Writes component data
+1 IF $DATA(GMTSQIT)
QUIT
NEW X,GMTSEDT
SET GMDATA=1
SET X=+^TMP("RAE",$JOB,GMTSIDT,GMTSPN,0)
DO REGDT4^GMTSU
SET GMTSEDT=X
+2 DO HD
SET GMTSPC=+($GET(GMTSCP))+1
IF $DATA(GMTSQIT)
QUIT
DO HD
IF $DATA(GMTSQIT)
QUIT
+3 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE GMTSEDT
DO PRO
DO CMD
DO IMP
QUIT
+4 QUIT
PRO ; Procedure
+1 NEW GMTSPRO,GMTSTA,GMTSEXS,GMTSCN,GMTSCPT,GMTSI
+2 SET GMTSPRO=$PIECE(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,0),"^",2)
SET GMTSTA=$PIECE(^(0),"^",4)
+3 SET GMTSTA=$SELECT(GMTSTA="RELEASED/NOT VERIFIED":"REL/NOT VER",GMTSTA="PROBLEM DRAFT":"PROB DRAFT",1:GMTSTA)
+4 SET GMTSCPT=$PIECE(^(0),"^",7)
SET GMTSEXS=$PIECE(^(0),"^",3)
SET GMTSCN=$PIECE(^(0),"^",9)
+5 IF '$LENGTH(GMTSTA)&(GMTSEXS="CANCELLED")
SET GMTSTA=GMTSEXS
+6 IF '$LENGTH(GMTSTA)
SET GMTSTA="PENDING"
SET GMTSTA=$$EN2^GMTSUMX(GMTSTA)
+7 IF $LENGTH(GMTSPRO)>35
SET GMTSPRO=$$WRAP^GMTSORC(GMTSPRO,31)
+8 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE ?12,$PIECE(GMTSPRO,"|"),?46,GMTSCPT,?52,$EXTRACT(GMTSTA,1,17),?64,GMTSCN,!
+9 FOR GMTSI=2:1:$LENGTH(GMTSPRO,"|")
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
IF $PIECE(GMTSPRO,"|",GMTSI)]""
WRITE ?23,$PIECE(GMTSPRO,"|",GMTSI),!
+10 QUIT
CMD ; CPT Modifiers
+1 ;
+2 ; Quit - CPT Modifiers will not be used with
+3 ; Radiology Impression (RI) and Radiology
+4 ; Impression Selected (SRI) at this time
+5 QUIT
+6 NEW GMTSCPTM
+7 SET GMTSCPTM=+($$CPT^GMTSU(+($GET(GMTSEGN))))
IF $GET(GMPXCMOD)="N"
SET GMTSCPTM=0
+8 IF 'GMTSCPTM
QUIT
+9 NEW GMTSC,GMTSCM,GMTSCT,GMTSI
SET GMTSC=0
FOR
SET GMTSC=$ORDER(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"CM",GMTSC))
IF +GMTSC=0
QUIT
Begin DoDot:1
+10 SET GMTSCM=$PIECE($GET(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",1)
+11 IF '$LENGTH(GMTSCM)
QUIT
SET GMTSCT=$PIECE($GET(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",3)
IF '$LENGTH(GMTSCT)
QUIT
+12 SET GMTSCT=GMTSCT_" (CPT Mod "_GMTSCM_")"
IF $LENGTH(GMTSCT)>35
SET GMTSCT=$$WRAP^GMTSORC(GMTSCT,62)
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE ?14,$PIECE(GMTSCT,"|"),!
+13 FOR GMTSI=2:1:$LENGTH(GMTSCT,"|")
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
IF $PIECE(GMTSCT,"|",GMTSI)]""
WRITE ?16,$PIECE(GMTSCT,"|",GMTSI),!
End DoDot:1
+14 QUIT
IMP ; Impression
+1 IF $DATA(GMTSQIT)
QUIT
NEW GMTSI,GMTST,DIWF,DIWL,DIWR
+2 SET GMTST=12
IF '$DATA(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"I"))
QUIT
KILL ^UTILITY($JOB,"W")
+3 SET DIWF="C"_(78-GMTST)
SET DIWL=0
SET DIWR=0
SET GMTSI=0
+4 FOR
SET GMTSI=$ORDER(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"I",GMTSI))
IF +GMTSI=0
QUIT
Begin DoDot:1
+5 SET X=$GET(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"I",GMTSI))
+6 ; DBIA 10011 call ^DIWP
+7 DO ^DIWP
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+8 SET GMTSI=0
FOR
SET GMTSI=$ORDER(^UTILITY($JOB,"W",0,GMTSI))
IF +GMTSI=0
QUIT
Begin DoDot:1
+9 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE ?GMTST,$GET(^UTILITY($JOB,"W",0,GMTSI,0)),!
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+10 KILL ^UTILITY($JOB,"W")
+11 QUIT
HD ; Header/Page Check
+1 IF $DATA(GMTSQIT)
QUIT
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
IF +($GET(GMTSNPG))=0&(+($GET(GMTSPC))>0)
QUIT
+2 WRITE "Date",?12,"Procedure",?46,"CPT",?52,"Status",?64,"Case #",!
+3 QUIT
RP(X) ; Radiology Patient
+1 NEW Y
SET X=+($GET(X))
+2 ; DBIA 2056 call $$GET1^DIQ
+3 SET Y=$$GET1^DIQ(70,X,.01,"I")
SET X=Y
QUIT X
