source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSCNB.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 6.8 KB
Line 
1GMTSCNB ; SLC/KER - Consults Components Brief ; 01/06/2003
2 ;;2.7;Health Summary;**46,47,58**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 3358 ^GMR(123,
6 ; DBIA 10040 ^SC(
7 ; DBIA 10104 $$UP^XLFSTR
8 ; DBIA 2056 $$GET1^DIQ (file 123.1, 44)
9 ; DBIA 2056 GETS^DIQ (file 123)
10 ; DBIA 2051 LIST^DIC (file 123.02)
11 ;
12 Q
13MAIN ; Consults - Brief
14 K ^TMP("GMTSCN")
15 N GMTSMAX,GMTSNMC,GMTSI,GMTSDFN S GMTSDFN=+($G(DFN))
16 S:'$L($G(GMTS1)) GMTS1=6666666 S:'$L($G(GMTS2)) GMTS2=9999999
17 S GMTS1=+($G(GMTS1)),GMTS2=+($G(GMTS2)),GMTSMAX=+($G(GMTSNDM)) S:GMTSMAX'>0 GMTSMAX=999999999
18 S GMTSDFN=+($G(GMTSDFN)) Q:GMTSDFN=0 Q:'$D(^GMR(123,"AD",GMTSDFN))
19 S:GMTS2>GMTS1 GMTSI=GMTS1,GMTS1=GMTS2,GMTS2=GMTSI S GMTSI=GMTS2-.00000001
20 F S GMTSI=$O(^GMR(123,"AD",GMTSDFN,GMTSI)) Q:+GMTSI=0!(GMTSI>GMTS1) D Q:$D(GMTSQIT)
21 . S GMTSIEN=0 F S GMTSIEN=$O(^GMR(123,"AD",GMTSDFN,GMTSI,GMTSIEN)) Q:+GMTSIEN=0 D Q:$D(GMTSQIT)
22 . . Q:+($G(GMTSNMC))>+($G(GMTSMAX)) K ^TMP("GMTSCN",$J)
23 . . D EXT(GMTSIEN,GMTSI) Q:$D(GMTSQIT) D BCD Q:$D(GMTSQIT)
24 Q
25BCD ; Brief Consults Display
26 Q:'$D(^TMP("GMTSCN",$J)) S GMTSNMC=+($G(GMTSNMC))+1
27 D:GMTSNMC=1 BHDR Q:$D(GMTSQIT)
28 N GMTSID,GMTSFI,GMTSIE S GMTSID=0
29 F S GMTSID=$O(^TMP("GMTSCN",$J,GMTSID)) Q:+GMTSID=0 D Q:$D(GMTSQIT)
30 . S GMTSFI=123,GMTSIE="" F S GMTSIE=$O(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE)) Q:GMTSIE="" D Q:$D(GMTSQIT)
31 . . N GMTSNB,GMTSRD,GMTSTO,GMTSVC,GMTSFM,GMTSLA,GMTSAD
32 . . S GMTSNB=+($G(GMTSIE)) S:+GMTSNB=0 GMTSNB="?"
33 . . S GMTSRD=$G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,3,"I"))
34 . . S GMTSRD=$$UP^XLFSTR($S(+GMTSRD>0:$$ED^GMTSU(+GMTSRD),1:"UNKNOWN"))
35 . . S GMTSFM=$$UP^XLFSTR($G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,2,"E")))
36 . . S GMTSTO=$$UP^XLFSTR($G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,1,"E")))
37 . . S GMTSLA=$$UP^XLFSTR($G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,40,1,1,"E")))
38 . . S GMTSLD=$G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,40,1,2,"I"))
39 . . S GMTSLD=$$UP^XLFSTR($S(+GMTSLD>0:$$ED^GMTSU(+GMTSLD),1:"UNKNOWN"))
40 . . D WRT
41 Q
42BHDR ; Brief Header
43 N GMTSL S $P(GMTSL,"-",79)=""
44 D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Request Date/",?15,"Request From"
45 D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Number",?15,"Request To",?52,"Last Action",?67,"Action Date"
46 D CKP^GMTSUP Q:$D(GMTSQIT) W !,GMTSL
47 Q
48WRT ; Write Brief Consult
49 D CKP^GMTSUP Q:$D(GMTSQIT) W !,$E(GMTSRD,1,10),?15,GMTSFM,?52,GMTSLA,?67,GMTSLD
50 D CKP^GMTSUP Q:$D(GMTSQIT) W !,GMTSNB,?15,GMTSTO
51 D CKP^GMTSUP Q:$D(GMTSQIT) W !
52 Q
53EXT(X,Y) ; Extract Consults
54 K ^TMP("GMTSCN",$J),^UTILITY("DIQ1",$J) N DIC,DIQ,DR,GMTSFM,GMTSI
55 N GMTSIEN,GMTSIENS,GMTSLA,GMTSRT,GMTSTY,GMTSVC
56 S GMTSIEN=+($G(X)) Q:GMTSIEN=0 S GMTSI=+($G(Y))
57 S DIC=123,GMTSIENS=+($G(GMTSIEN))_","
58 S GMTSRT="^TMP(""GMTSCN"","_$J_","_GMTSI_")"
59 S DIQ(0)="IE",DR=".01;1;2;3;9" D GETS^DIQ(123,GMTSIENS,DR,"EI",GMTSRT,"MSG")
60 S GMTSFM=+($G(^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,2,"I"))) S:+GMTSFM=0 GMTSFM=""
61 S GMTSVC="" S:+GMTSFM>0 GMTSVC=$$GET1^DIQ(44,GMTSFM,9,"E") S:$G(GMTSVC)="NONE" GMTSVC=""
62 S:$L(GMTSVC) ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,2,"SVC")=GMTSVC
63 S GMTSTY="" S:+GMTSFM>0 GMTSTY=$$GET1^DIQ(44,GMTSFM,2,"E")
64 S GMTSFM=$$FM(($G(^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,2,"E"))_"^"_GMTSTY_"^"_GMTSVC))
65 S ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,2,"E")=GMTSFM
66 S GMTSLA=+($G(^TMP("GMTSCN",$J,GMTSI,DIC,GMTSIENS,9,"I")))
67 S:+GMTSLA'>9 ^TMP("GMTSCN",$J,GMTSI,DIC,GMTSIENS,9,"E")=""
68 I +GMTSLA>0 D
69 . S GMTSLA=$$GET1^DIQ(123.1,GMTSLA,7,"E")
70 . S ^TMP("GMTSCN",$J,GMTSI,DIC,GMTSIENS,9,"E")=GMTSLA
71 S ^TMP("GMTSCN",$J,GMTSI,DIC,GMTSIENS,0)=(9999999-GMTSI)_"^"_$S(GMTSI>0:$$EDT^GMTSU((9999999-GMTSI)),1:"")
72 D ACT
73 Q
74FM(X) ; From Service/Ward
75 S X=$G(X) N GMTSTY,GMTSV S GMTSTY=$P(X,"^",2),GMTSV=$P(X,"^",3),X=$P(X,"^",1)
76 I $L(X) S:+X>0&(GMTSTY="WARD")&(X'["WARD") X="WARD "_X S:+X'>0&(GMTSTY="WARD")&(X'["WARD") X=X_" WARD"
77 S:($L(X)+$L(GMTSV)+3)'>30&($L(GMTSV))&(X'[GMTSV) X=X_" ("_GMTSV_")"
78 S X=$$UP^XLFSTR(X)
79 Q X
80ACT ; Activity
81 N GMTSL,GMTSFL,GMTSFLA,GMTSFLD,GMTSLA,GMTSLD,GMTSLR,GMTSAM,GMTSLM,GMTSC,GMTSDI,Y,DR,GMTSIENL,GMTSIENS,GMTSMSG K ^TMP("DILIST",$J)
82 S GMTSIENS=+GMTSIEN_",",GMTSIENL=","_GMTSIENS,DR="1I;2I;9;10"
83 D LIST^DIC(123.02,GMTSIENL,DR,,"*",,,,,,.GMTSDI,"GMTSMSG")
84 K:+($G(^TMP("DILIST",$J,0)))=0 ^TMP("DILIST",$J) Q:+($G(^TMP("DILIST",$J,0)))=0
85 S GMTSLA="",GMTSLD=0,GMTSLR="",GMTSAM="",GMTSC=0
86 S GMTSL=0
87 F S GMTSL=$O(^TMP("DILIST",$J,"ID",GMTSL)) Q:+GMTSL=0 D
88 . I +($G(^TMP("DILIST",$J,"ID",GMTSL,2)))'<GMTSLD,+($G(^TMP("DILIST",$J,"ID",GMTSL,2)))>0 D
89 . . S GMTSLA=+($G(^TMP("DILIST",$J,"ID",GMTSL,1)))
90 . . S GMTSLD=+($G(^TMP("DILIST",$J,"ID",GMTSL,2)))
91 . . S GMTSLR=$G(^TMP("DILIST",$J,"ID",GMTSL,9))
92 . . S GMTSLM=$G(^TMP("DILIST",$J,"ID",GMTSL,10))
93 I +($G(GMTSFLA))>0,+($G(GMTSFLD))>0,+($G(GMTSFL))>0,+($G(GMTSR))'>0 S GMTSC=0,GMTSLA=GMTSFLA,GMTSLD=GMTSFLA D AAC
94 I GMTSLA>0,GMTSLD>0 S GMTSC=1 D AAC
95 K ^TMP("DILIST",$J)
96 Q
97AAC ; Add Activity
98 N GMTSEA,GMTSEP,GMTSEL,GMTSOR,GMTSW,I S GMTSC=+($G(GMTSC))
99 S GMTSOR=$$UP^XLFSTR($$GET1^DIQ(123.1,GMTSLA,1,"I"))
100 S GMTSEP=$$UP^XLFSTR($$GET1^DIQ(123.1,GMTSLA,7,"E"))
101 S GMTSEA=$$UP^XLFSTR($$GET1^DIQ(123.1,GMTSLA,.01,"E"))
102 S GMTSEL=$$AL(GMTSEA,GMTSEP) Q:'$L(GMTSEL)
103 S GMTSEA=$$AN(GMTSEA,GMTSEP) Q:'$L(GMTSEA)
104 I GMTSC>0 D
105 . S ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,GMTSC,1,"I")=GMTSLA,^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,GMTSC,1,"E")=GMTSEA,^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,GMTSC,1,"L")=GMTSEL
106 . S ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,GMTSC,2,"I")=GMTSLD,^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,GMTSC,2,"E")=$$EDT^GMTSU(GMTSLD)
107 I GMTSC'>0 D
108 . S ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,"LA","I")=GMTSLA,^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,"LA","E")=GMTSEA,^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,"LA","L")=GMTSEL
109 . S ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,"LD","I")=GMTSLD,^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,"LD","E")=$$EDT^GMTSU(GMTSLD)
110 . S ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,"WR","E")=$G(^TMP("DILIST",$J,"ID",GMTSFL,3))
111 Q
112AN(X,Y) ; Activity Name
113 N GMTSW,GMTSP,GMTSA S GMTSA=$G(X),GMTSP=$G(Y) S X=$$SN((GMTSA_" "_GMTSP)) S X=$E(X,1,11) Q X
114AL(X,Y) ; Activity Name
115 N GMTSP,GMTSA S GMTSA=$G(X),GMTSP=$G(Y) S:GMTSA["RECEIVE" (GMTSA,GMTSP)="RECEIVED"
116 S:GMTSA="ENTERED IN CPRS"!(GMTSA["CPRS RELEASED") (GMTSA,GMTSP)="DATA ENTRY" S:GMTSA="EDIT BEFORE RELEASE" (GMTSA,GMTSP)="EDITED"
117 S X="" S:$L(GMTSA)&($L(GMTSP)) X=$S($L(GMTSP)>$L(GMTSA):GMTSP,1:GMTSA) S:'$L(GMTSA)!('$L(GMTSP)) X=$S('$L(GMTSP)&($L(GMTSA)):GMTSA,$L(GMTSP)&('$L(GMTSA)):GMTSP,1:"")
118 Q X
119SN(X) ;
120 S X=$G(X) Q:X="" "UNKNOWN" Q:X["ENTERED"!(X["RELEASED") "ENTERED" Q:X["STATUS" "STAT CHG"
121 Q:X["SIGNIF" "SIG FIND" Q:X["DISCONT" "DISCONT'D" Q:X["SCHEDUL" "SCHEDULED" Q:X["INCOMPL" "INCOMPLETE" Q:X["COMPLET" "COMPLETE"
122 Q:X["EDIT" "EDITED" Q:X["DISASSO" "DISASSOC'D" Q:X["ADDENDUM" "ADDENDUM" Q:X["NEW NOTE" "NEW NOTE"
123 Q:X["SERVICE" "SVC ENTER" Q:X["FORWARD" "FORWARDED" Q:X["CANCELLED" "CANCELLED" Q:X["COMMENT" "COMMENT" Q:X["RECEIVED" "RECEIVED" Q:X["PRINTED" "PRINTED"
124 Q "UNKNOWN"
Note: See TracBrowser for help on using the repository browser.