- GMTSRASP ; SLC/JER,KER - Selected Radiology ; 01/06/2003
- ;;2.7;Health Summary;**28,37,58,88**;Oct 20, 1995;Build 23
- ;
- MAIN ; Controls branching
- Q:+($G(DFN))=0 Q:+($G(DFN))'=+($$RP(+($G(DFN))))
- ; VM/RJT - PATCH TIU*1*227 - newed variable GMTSPC
- N GMTSI,GMW,MAX,GMTSTEST,GMDATA,GMTSPC
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRASP 3402 printed Feb 18, 2025@23:26:24 Page 2
- GMTSRASP ; SLC/JER,KER - Selected Radiology ; 01/06/2003
- +1 ;;2.7;Health Summary;**28,37,58,88**;Oct 20, 1995;Build 23
- +2 ;
- MAIN ; Controls branching
- +1 if +($GET(DFN))=0
- QUIT
- if +($GET(DFN))'=+($$RP(+($GET(DFN))))
- QUIT
- +2 ; VM/RJT - PATCH TIU*1*227 - newed variable GMTSPC
- +3 NEW GMTSI,GMW,MAX,GMTSTEST,GMDATA,GMTSPC
- +4 SET MAX=$SELECT(+$GET(GMTSNDM)>0:GMTSNDM,1:999)
- +5 IF '$ORDER(GMTSEG(GMTSEGN,71,0))
- QUIT
- +6 SET GMTSI=0
- FOR
- SET GMTSI=$ORDER(GMTSEG(GMTSEGN,71,GMTSI))
- if GMTSI'>0
- QUIT
- Begin DoDot:1
- +7 SET GMTSTEST=GMTSEG(GMTSEGN,71,GMTSI)
- +8 DO MAINSEL^GMTSRAE(1,GMTSTEST)
- if $DATA(^TMP("RAE",$JOB))
- DO LOOP
- End DoDot:1
- +9 KILL ^TMP("RAE",$JOB)
- +10 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