source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSRASP.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1GMTSRASP ; SLC/JER,KER - Selected Radiology ; 01/06/2003
2 ;;2.7;Health Summary;**28,37,58**;Oct 20, 1995
3 ;
4MAIN ; Controls branching
5 Q:+($G(DFN))=0 Q:+($G(DFN))'=+($$RP(+($G(DFN))))
6 N GMTSI,GMW,MAX,GMTSTEST,GMDATA
7 S MAX=$S(+$G(GMTSNDM)>0:GMTSNDM,1:999)
8 I '$O(GMTSEG(GMTSEGN,71,0)) Q
9 S GMTSI=0 F S GMTSI=$O(GMTSEG(GMTSEGN,71,GMTSI)) Q:GMTSI'>0 D
10 . S GMTSTEST=GMTSEG(GMTSEGN,71,GMTSI)
11 . D MAINSEL^GMTSRAE(1,GMTSTEST),LOOP:$D(^TMP("RAE",$J))
12 K ^TMP("RAE",$J)
13 Q
14LOOP ; Loops through ^TMP("RAE",$J,
15 N GMW,GMTSIDT,GMTSPN,GMLN
16 S GMTSIDT=0 F S GMTSIDT=$O(^TMP("RAE",$J,GMTSIDT)) Q:GMTSIDT'>0 D Q:$D(GMTSQIT)
17 . S GMTSPN=0 F S GMTSPN=$O(^(GMTSIDT,GMTSPN)) Q:GMTSPN'>0 D WRT Q:$D(GMTSQIT)
18 Q
19WRT ; Writes component data
20 Q:$D(GMTSQIT) N X,GMTSEDT S GMDATA=1,X=+^TMP("RAE",$J,GMTSIDT,GMTSPN,0) D REGDT4^GMTSU S GMTSEDT=X
21 D HD S GMTSPC=+($G(GMTSCP))+1 Q:$D(GMTSQIT) D HD Q:$D(GMTSQIT)
22 D CKP^GMTSUP Q:$D(GMTSQIT) W GMTSEDT D PRO,CMD,IMP Q
23 Q
24PRO ; Procedure
25 N GMTSPRO,GMTSTA,GMTSEXS,GMTSCN,GMTSCPT,GMTSI
26 S GMTSPRO=$P(^TMP("RAE",$J,GMTSIDT,GMTSPN,0),"^",2),GMTSTA=$P(^(0),"^",4)
27 S GMTSTA=$S(GMTSTA="RELEASED/NOT VERIFIED":"REL/NOT VER",GMTSTA="PROBLEM DRAFT":"PROB DRAFT",1:GMTSTA)
28 S GMTSCPT=$P(^(0),"^",7),GMTSEXS=$P(^(0),"^",3),GMTSCN=$P(^(0),"^",9)
29 S:'$L(GMTSTA)&(GMTSEXS="CANCELLED") GMTSTA=GMTSEXS
30 S:'$L(GMTSTA) GMTSTA="PENDING" S GMTSTA=$$EN2^GMTSUMX(GMTSTA)
31 I $L(GMTSPRO)>35 S GMTSPRO=$$WRAP^GMTSORC(GMTSPRO,31)
32 D CKP^GMTSUP Q:$D(GMTSQIT) W ?12,$P(GMTSPRO,"|"),?46,GMTSCPT,?52,$E(GMTSTA,1,17),?64,GMTSCN,!
33 F GMTSI=2:1:$L(GMTSPRO,"|") D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(GMTSPRO,"|",GMTSI)]"" ?23,$P(GMTSPRO,"|",GMTSI),!
34 Q
35CMD ; CPT Modifiers
36 ;
37 ; Quit - CPT Modifiers will not be used with
38 ; Radiology Impression (RI) and Radiology
39 ; Impression Selected (SRI) at this time
40 Q
41 N GMTSCPTM
42 S GMTSCPTM=+($$CPT^GMTSU(+($G(GMTSEGN)))) S:$G(GMPXCMOD)="N" GMTSCPTM=0
43 Q:'GMTSCPTM
44 N GMTSC,GMTSCM,GMTSCT,GMTSI S GMTSC=0 F S GMTSC=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)) Q:+GMTSC=0 D
45 . S GMTSCM=$P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",1)
46 . Q:'$L(GMTSCM) S GMTSCT=$P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",3) Q:'$L(GMTSCT)
47 . 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,"|"),!
48 . F GMTSI=2:1:$L(GMTSCT,"|") D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(GMTSCT,"|",GMTSI)]"" ?16,$P(GMTSCT,"|",GMTSI),!
49 Q
50IMP ; Impression
51 Q:$D(GMTSQIT) N GMTSI,GMTST,DIWF,DIWL,DIWR
52 S GMTST=12 Q:'$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,"I")) K ^UTILITY($J,"W")
53 S DIWF="C"_(78-GMTST),DIWL=0,DIWR=0,GMTSI=0
54 F S GMTSI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"I",GMTSI)) Q:+GMTSI=0 D Q:$D(GMTSQIT)
55 . S X=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"I",GMTSI))
56 . ; DBIA 10011 call ^DIWP
57 . D ^DIWP
58 S GMTSI=0 F S GMTSI=$O(^UTILITY($J,"W",0,GMTSI)) Q:+GMTSI=0 D Q:$D(GMTSQIT)
59 . D CKP^GMTSUP Q:$D(GMTSQIT) W ?GMTST,$G(^UTILITY($J,"W",0,GMTSI,0)),!
60 K ^UTILITY($J,"W")
61 Q
62HD ; Header/Page Check
63 Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT) Q:+($G(GMTSNPG))=0&(+($G(GMTSPC))>0)
64 W "Date",?12,"Procedure",?46,"CPT",?52,"Status",?64,"Case #",!
65 Q
66RP(X) ; Radiology Patient
67 N Y S X=+($G(X))
68 ; DBIA 2056 call $$GET1^DIQ
69 S Y=$$GET1^DIQ(70,X,.01,"I") S X=Y Q X
Note: See TracBrowser for help on using the repository browser.