GMTSRAI ; SLC/JER,KER - Radiology Impression Comp ; 09/21/2001
;;2.7;Health Summary;**28,37,47**;Oct 20, 1995
;
; External References
; DBIA 3125 ^RADPT( file 70
; DBIA 2056 $$GET1^DIQ (file 70)
; DBIA 10011 ^DIWP
;
ENSRA ; Controls branching
Q:+($G(DFN))=0 Q:+($G(DFN))'=+($$RP(+($G(DFN))))
K ^TMP("RAE",$J)
N GMDATA,GMTSCP D MAIN^GMTSRAE(1) Q:'$D(^TMP("RAE",$J))
D LOOP K ^TMP("RAE",$J)
Q
LOOP ; Loops through ^TMP("RAE",$J,
N GMTSIDT,GMTSPN,GMTSPC S (GMTSIDT,GMTSPC)=0 F S GMTSIDT=$O(^TMP("RAE",$J,GMTSIDT)) Q:GMTSIDT'>0 D Q:$D(GMTSQIT)
. S GMTSPN=0 F S GMTSPN=$O(^TMP("RAE",$J,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) W GMTSEDT D PRO,IMP Q
Q
PRO ; Procedure
N GMTSPRO,GMTSEST,GMTSTA,GMTSCPT,GMTSI,GMTSCN
S GMTSPRO=$P(^TMP("RAE",$J,GMTSIDT,GMTSPN,0),"^",2),GMTSEST=$P(^(0),"^",3),GMTSTA=$P(^(0),"^",4),GMTSCPT=$P(^(0),"^",7),GMTSCN=$P(^(0),"^",9)
S GMTSTA=$S(GMTSTA="RELEASED/NOT VERIFIED":"REL/NOT VER",GMTSTA="PROBLEM DRAFT":"PROB DRAFT",1:GMTSTA)
S GMTSTA=$S(GMTSEST["CANCEL":"CANCELLED",1:GMTSTA)
S GMTSTA=$$EN2^GMTSUMX(GMTSTA)
I $L(GMTSPRO)>31 S GMTSPRO=$$WRAP^GMTSORC(GMTSPRO,31)
D HD Q:$D(GMTSQIT)
W ?12,$P(GMTSPRO,"|"),?46,GMTSCPT,?52,$E(GMTSTA,1,11),?64,$G(GMTSCN),!
F GMTSI=2:1:$L(GMTSPRO,"|") D Q:$D(GMTSQIT)
. D HD Q:$D(GMTSQIT) W:$P(GMTSPRO,"|",GMTSI)]"" ?14,$P(GMTSPRO,"|",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)) D ^DIWP
S GMTSI=0 F S GMTSI=$O(^UTILITY($J,"W",0,GMTSI)) Q:+GMTSI=0 D Q:$D(GMTSQIT)
. D HD 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)) S Y=$$GET1^DIQ(70,X,.01,"I") S X=Y Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRAI 2380 printed Dec 13, 2024@02:00 Page 2
GMTSRAI ; SLC/JER,KER - Radiology Impression Comp ; 09/21/2001
+1 ;;2.7;Health Summary;**28,37,47**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 3125 ^RADPT( file 70
+5 ; DBIA 2056 $$GET1^DIQ (file 70)
+6 ; DBIA 10011 ^DIWP
+7 ;
ENSRA ; Controls branching
+1 if +($GET(DFN))=0
QUIT
if +($GET(DFN))'=+($$RP(+($GET(DFN))))
QUIT
+2 KILL ^TMP("RAE",$JOB)
+3 NEW GMDATA,GMTSCP
DO MAIN^GMTSRAE(1)
if '$DATA(^TMP("RAE",$JOB))
QUIT
+4 DO LOOP
KILL ^TMP("RAE",$JOB)
+5 QUIT
LOOP ; Loops through ^TMP("RAE",$J,
+1 NEW GMTSIDT,GMTSPN,GMTSPC
SET (GMTSIDT,GMTSPC)=0
FOR
SET GMTSIDT=$ORDER(^TMP("RAE",$JOB,GMTSIDT))
if GMTSIDT'>0
QUIT
Begin DoDot:1
+2 SET GMTSPN=0
FOR
SET GMTSPN=$ORDER(^TMP("RAE",$JOB,GMTSIDT,GMTSPN))
if GMTSPN'>0
QUIT
DO WRT
if $DATA(GMTSQIT)
QUIT
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+3 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
WRITE GMTSEDT
DO PRO
DO IMP
QUIT
+3 QUIT
PRO ; Procedure
+1 NEW GMTSPRO,GMTSEST,GMTSTA,GMTSCPT,GMTSI,GMTSCN
+2 SET GMTSPRO=$PIECE(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,0),"^",2)
SET GMTSEST=$PIECE(^(0),"^",3)
SET GMTSTA=$PIECE(^(0),"^",4)
SET GMTSCPT=$PIECE(^(0),"^",7)
SET GMTSCN=$PIECE(^(0),"^",9)
+3 SET GMTSTA=$SELECT(GMTSTA="RELEASED/NOT VERIFIED":"REL/NOT VER",GMTSTA="PROBLEM DRAFT":"PROB DRAFT",1:GMTSTA)
+4 SET GMTSTA=$SELECT(GMTSEST["CANCEL":"CANCELLED",1:GMTSTA)
+5 SET GMTSTA=$$EN2^GMTSUMX(GMTSTA)
+6 IF $LENGTH(GMTSPRO)>31
SET GMTSPRO=$$WRAP^GMTSORC(GMTSPRO,31)
+7 DO HD
if $DATA(GMTSQIT)
QUIT
+8 WRITE ?12,$PIECE(GMTSPRO,"|"),?46,GMTSCPT,?52,$EXTRACT(GMTSTA,1,11),?64,$GET(GMTSCN),!
+9 FOR GMTSI=2:1:$LENGTH(GMTSPRO,"|")
Begin DoDot:1
+10 DO HD
if $DATA(GMTSQIT)
QUIT
if $PIECE(GMTSPRO,"|",GMTSI)]""
WRITE ?14,$PIECE(GMTSPRO,"|",GMTSI),!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+11 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))
DO ^DIWP
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+6 SET GMTSI=0
FOR
SET GMTSI=$ORDER(^UTILITY($JOB,"W",0,GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+7 DO HD
if $DATA(GMTSQIT)
QUIT
WRITE ?GMTST,$GET(^UTILITY($JOB,"W",0,GMTSI,0)),!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+8 KILL ^UTILITY($JOB,"W")
+9 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))
SET Y=$$GET1^DIQ(70,X,.01,"I")
SET X=Y
QUIT X
