Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMTSRAS

GMTSRAS.m

Go to the documentation of this file.
  1. GMTSRAS ; SLC/JER,KER HIN/GJC - Radiology Profile ; 04/19/2002
  1. ;;2.7;Health Summary;**14,25,28,37,47,51,84**;Oct 20, 1995;Build 6
  1. ;
  1. ; External References
  1. ; DBIA 3125 ^RADPT( file 70
  1. ; DBIA 2056 $$GET1^DIQ (file 70)
  1. ; DBIA 10011 ^DIWP
  1. ;
  1. ENSRA ; Controls branching
  1. Q:+($G(DFN))=0 Q:+($G(DFN))'=+($$RP(+($G(DFN))))
  1. N GMDATA D MAIN^GMTSRAE(2) Q:'$D(^TMP("RAE",$J))
  1. D LOOP K ^TMP("RAE",$J) Q
  1. LOOP ; Loops through ^TMP("RAE",$J,
  1. N GMW,GMTSORD,GMTSIDT,GMTSPN,GMLN,GMPSET,GMXSET S GMTSIDT=0
  1. F S GMTSIDT=$O(^TMP("RAE",$J,GMTSIDT)) Q:GMTSIDT'>0 D Q:$D(GMTSQIT)
  1. . S GMPSET=$S($D(^TMP("RAE",$J,GMTSIDT,"PRINTSET")):1,1:0)
  1. . S GMXSET=$S($D(^TMP("RAE",$J,GMTSIDT,"EXAMSET")):1,1:0)
  1. . S GMTSPN=0 F S GMTSPN=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN)) Q:GMTSPN'>0 D
  1. . . S GMTSORD=+($P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,0)),"^",10))
  1. . . D WRT D:+$O(^TMP("RAE",$J,GMTSIDT,GMTSPN)) BL Q:$D(GMTSQIT)
  1. . D:+$O(^TMP("RAE",$J,GMTSIDT)) BL Q:$D(GMTSQIT)
  1. Q
  1. WRT ; Writes component data
  1. Q:$D(GMTSQIT) N X,GMI,GMTMP S GMDATA=1,GMTMP=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,0))
  1. D CKP^GMTSUP Q:$D(GMTSQIT)
  1. D DAT,PRO D:'GMPSET SSET D:GMPSET PSET
  1. Q
  1. ;
  1. SSET ; Output for Non-Printsets (single exam) (GMPSET=0)
  1. ;
  1. ; Procedure Modifiers, Procedure Status,
  1. ; CPT Code, CPT Modifiers, Interpreting Staff,
  1. ; Interpreting Resident, Report Status,
  1. ; Technologist, Report Text
  1. ;
  1. D:$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M")) PMD D CPT,CMD,INS,INR,CAS,EST,STT,RPT
  1. Q
  1. PSET ; Output for Printsets (GMPSET=1)
  1. ;
  1. ; Procedure Modifiers, Procedure Status,
  1. ; CPT Code, CPT Modifier, Report Status,
  1. ; Technologist
  1. ;
  1. D:$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M")) PMD D CPT,CMD
  1. D:'+$O(^TMP("RAE",$J,GMTSIDT,GMTSPN)) LSET
  1. Q
  1. LSET ; Last Set/Case in Printset
  1. ;
  1. ; Interpreting Staff, Interpreting Resident, Report Status,
  1. ; Technologist, Report Text
  1. ;
  1. D BL,INS,INR,CAS,EST,STT N GMTSPN S GMTSPN=$O(^TMP("RAE",$J,GMTSIDT,0)) D:GMTSPN RPT
  1. Q
  1. ; Data Elements
  1. DAT ; Date +1
  1. Q:'$L($G(GMTMP)) Q:+($G(GMTMP))=0 Q:'$D(GMXSET) Q:'$D(GMTSPN) Q:+($G(GMTSIDT))=0
  1. N X,GMTSDT S X=+GMTMP D REGDT4^GMTSU S GMTSDT=X
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W:+($G(GMXSET))=0 GMTSDT
  1. W:(+($G(GMXSET))>0)&(GMTSPN=$O(^TMP("RAE",$J,GMTSIDT,0))) GMTSDT
  1. Q
  1. PRO ; Procedure 2
  1. Q:'$L($G(GMTMP)) N GMTSA,GMTSB S GMTSA=$P($G(GMTMP),"^",2)
  1. S:$L(GMTSA)>65 GMTSA=$$WRAP^GMTSORC(GMTSA,65)
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W ?12,$P(GMTSA,"|"),!
  1. F GMTSB=2:1:$L(GMTSA,"|") D Q:$D(GMTSQIT)
  1. . D CKP^GMTSUP Q:$D(GMTSQIT)
  1. . W:$P(GMTSA,"|",GMTSB)]"" ?23,$P(GMTSA,"|",GMTSB),!
  1. Q
  1. CAS ; Case Number 9
  1. Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P(GMTMP,"^",9) Q:GMTSA=""
  1. Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W ?12,"Exam Case Number:",?33,GMTSA,!
  1. Q
  1. EST ; Exam Status 3
  1. Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P(GMTMP,"^",3) Q:GMTSA=""
  1. Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W ?12,"Exam Status:",?33,GMTSA,!
  1. Q
  1. RST ; Report Status 4
  1. Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P(GMTMP,"^",4) Q:GMTSA=""
  1. Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W ?12,"Rpt Status: ",GMTSA,!
  1. Q
  1. INR ; Interpreting Resident 5
  1. Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P(GMTMP,"^",5) Q:GMTSA=""
  1. Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W ?12,"Interpreting Res.:",?33,GMTSA,!
  1. Q
  1. INS ; Interpreting Staff 6
  1. Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P(GMTMP,"^",6) Q:GMTSA=""
  1. Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W ?12,"Interpreting Staff:",?33,GMTSA,!
  1. Q
  1. CPT ; CPT Code 7
  1. Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P($G(GMTMP),"^",7)
  1. Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W ?12,"CPT Code:",?25,GMTSA,!
  1. Q
  1. TEC ; Technologist 8
  1. Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P($G(GMTMP),"^",8) Q:GMTSA=""
  1. Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W ?12," Technologist: ",GMTSA,!
  1. Q
  1. STT ; Report Status/Technologist 4/8
  1. Q:'$L($G(GMTMP)) N GMTSA,GMTSB S GMTSA=$P(GMTMP,"^",4),GMTSB=$P(GMTMP,"^",8)
  1. Q:($G(GMTSA)_$G(GMTSB))="" Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W ?12,"Rpt Status: ",$E($G(GMTSA),1,18) W ?45," Technologist: ",$G(GMTSB),!
  1. Q
  1. CMD ; CPT Modifiers
  1. N GMTSCPTM
  1. S GMTSCPTM=+($$CPT^GMTSU(+($G(GMTSEGN)))) S:$G(GMPXCMOD)="N" GMTSCPTM=0
  1. Q:'GMTSCPTM Q:'$L($G(GMTMP)) N GMTSC,GMTSCM,GMTSCT,GMTSI,GMTSCNT S (GMTSC,GMTSCNT)=0
  1. F S GMTSC=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)) Q:+GMTSC=0 D
  1. . S GMTSCM=$P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",1) Q:'$L(GMTSCM)
  1. . S GMTSCT=$P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",3) Q:'$L(GMTSCT)
  1. . S GMTSCT=GMTSCM_" - "_GMTSCT
  1. . S GMTSCNT=GMTSCNT+1
  1. . S:$L(GMTSCT)>47 GMTSCT=$$WRAP^GMTSORC(GMTSCT,47)
  1. . D CKP^GMTSUP Q:$D(GMTSQIT)
  1. . W:GMTSCNT=1 ?12,"CPT Modifier:" W ?28,$P(GMTSCT,"|"),!
  1. . F GMTSI=2:1:$L(GMTSCT,"|") D Q:$D(GMTSQIT)
  1. . . D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(GMTSCT,"|",GMTSI)]"" ?33,$P(GMTSCT,"|",GMTSI),!
  1. Q
  1. PMD ; Procedure Modifiers
  1. Q:'$L($G(GMTMP)) D CKP^GMTSUP Q:$D(GMTSQIT) W:+($O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",0)))>0 ?12,"Procedure Modifier:"
  1. S GMI=0 F S GMI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMI)) Q:+GMI'>0 D
  1. . D CKP^GMTSUP Q:$D(GMTSQIT)
  1. . W ?33,^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMI),!
  1. Q
  1. ;
  1. RPT ; Report Text
  1. N GMTSL F GMTSL="S","H","A","R","I","D" D TXT(GMTSL)
  1. Q
  1. TXT(X) ; Report Text Lines
  1. N GMTST S GMTST=$E($G(X),1) Q:(GMTST="")!("^S^H^A^R^I^D^"'[GMTST)!(GMTST="^")
  1. Q:GMTST="A"&(+($$PROK^GMTSU("RAUTL9",27))=0)
  1. Q:+($G(GMTSIDT))=0 Q:+($G(GMTSPN))=0 Q:'$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST))
  1. K ^UTILITY($J,"W") N GMTSI,GMTSII,GMTSIND,DIWF,DIWL,DIWR S GMTSIND=12,DIWF="C"_(78-(GMTSIND+2)),DIWL=0,DIWR=0,GMTSI=0
  1. D:$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,0))>0 BL
  1. D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W ?GMTSIND,$S(GMTST="S":"Reason for Study: ",GMTST="H":"History: ",GMTST="A":"Additional History: ",GMTST="R":"Report: ",GMTST="I":"Impression: ",GMTST="D":"DX Codes: ",1:"Text:"),!
  1. I GMTST'="D" D
  1. . S GMTSI=0 F S GMTSI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) Q:GMTSI'>0 D Q:$D(GMTSQIT)
  1. . . S X=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) D ^DIWP
  1. I GMTST="D" D
  1. . S GMTSI=0 F S GMTSI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) Q:GMTSI'>0 D Q:$D(GMTSQIT)
  1. . . S X=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) S:$L(X)>(78-(GMTSIND+4)) X=$$WRAP^GMTSORC(X,(78-(GMTSIND+4)))
  1. . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?(GMTSIND+2),$P(X,"|",1),! F GMTSII=2:1:$L(X,"|") D Q:$D(GMTSQIT)
  1. . . . D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(X,"|",GMTSII)]"" ?(GMTSIND+4),$P(X,"|",GMTSII),!
  1. I $D(^UTILITY($J,"W")) D
  1. . S GMTSI=0 F S GMTSI=$O(^UTILITY($J,"W",0,GMTSI)) Q:+GMTSI=0 D Q:$D(GMTSQIT)
  1. . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?(GMTSIND+2),$G(^UTILITY($J,"W",0,GMTSI,0)),!
  1. K ^UTILITY($J,"W")
  1. Q
  1. BL ; Report Blank Lines
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W ! Q
  1. ;
  1. RP(X) ; Radiology Patient
  1. N Y S X=+($G(X)) S Y=$$GET1^DIQ(70,X,.01,"I") S X=Y Q X