- 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 Feb 18, 2025@23:26:21 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
