source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSTL2.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: 5.5 KB
Line 
1GMRCSTL2 ;SLC/DCM,dee;MA - List Manager Format Routine - Get Active Consults by service - pending,active,scheduled,incomplete,etc. ;4/18/01 10:31
2 ;;3.0;CONSULT/REQUEST TRACKING;**7,21,22**;DEC 27, 1997
3 ; Patch #21 changed array GMRCTOT to ^TMP("GMRCTOT",$J)
4 ; Patch #21 also added a plus sign to the $P when setting
5 ; GMRCDLA to check for a NULL value.
6 ; This routine invokes IA #10035,#44, #10040
7 Q
8 ;
9ONESTAT(GMRCARRN) ;Process one status
10 ; Input -- GMRCARRN List Template Array Name (Subscript)
11 ; Values:
12 ; "CP": pending consults; "IFC": inter-facility consults
13 ; Output - None
14 S ^TMP("GMRCTOT",$J,1,GMRCSVC,STATUS)=0
15 S ^TMP("GMRCTOT",$J,2,GMRCSVC,STATUS)=0
16 S GMRCXDT=$S(GMRCDT1="ALL":0,1:9999999-GMRCDT2-.6)
17 F S GMRCXDT=$O(^GMR(123,"AE",GMRCSVC,STATUS,GMRCXDT)) Q:GMRCXDT=""!(GMRCXDT>(9999999-GMRCDT1)) D
18 .S GMRCPT=0
19ONE .;Loop for one consult at a time
20 .F S GMRCPT=$O(^GMR(123,"AE",GMRCSVC,STATUS,GMRCXDT,GMRCPT)) Q:GMRCPT="" D
21 ..; Check for bad "AE" x-ref
22 ..I '$D(^GMR(123,GMRCPT,0)) D Q
23 ...K ^GMR(123,"AE",GMRCSVC,STATUS,GMRCXDT,GMRCPT)
24 ..S X=9999999-GMRCXDT
25 ..D REGDTM^GMRCU
26 ..S GMRCDT=$P(X," ",1)
27 ..S GMRCDLA=$P(X," ",1)
28 ..S GMRCD(0)=^GMR(123,GMRCPT,0)
29 ..I GMRCARRN="IFC" D Q:'GMRCCK
30 ...S GMRCCK=1
31 ...S:'$D(GMRCIS) GMRCCK=0 S:'$P($G(GMRCD(0)),"^",23) GMRCCK=0
32 ...I GMRCCK=1 D
33 ....S GMRCD(12)=$G(^GMR(123,GMRCPT,12))
34 ....I GMRCIS="R",$P(GMRCD(12),"^",5)'="P" S GMRCCK=0
35 ....I GMRCIS="C",$P(GMRCD(12),"^",5)'="F" S GMRCCK=0
36 ....I $D(GMRCREMP),$P(GMRCD(12),"^",6)'=GMRCREMP S GMRCCK=0
37 ....I $D(GMRCRF),$P($G(GMRCD(0)),"^",23)'=GMRCRF S GMRCCK=0
38 ..S GMRCPTN=$P(^DPT($P(GMRCD(0),"^",2),0),"^",1)
39 ..S GMRCPTN=$P(GMRCPTN,",",1)_","_$E($P(GMRCPTN,",",2),1)_"."
40 ..S GMRCPTSN="("_$E($P(^DPT($P(GMRCD(0),"^",2),0),"^",9),6,9)_")"
41 ..; IF Consults
42 ..I GMRCARRN="IFC" D
43 ...N GMRCIRF,RCVDT,COMPLDT,ND
44 ...S GMRCIRFN="NONE",GMRCIDD="N/A",GMRCRDT=""
45 ...S GMRCIRF=$P($G(GMRCD(0)),"^",23)
46 ... I GMRCIRF S GMRCIRFN=$E($$GET1^DIQ(4,GMRCIRF,.01),1,16)
47 ...I '$D(^TMP("GMRCTOT",$J,1,GMRCSVC,"F",GMRCIRFN)) D
48 ....S ^TMP("GMRCTOT",$J,1,GMRCSVC,"F",GMRCIRFN)=0
49 ....S GMRCST(1,GMRCSVC,GMRCIRFN)="0^0"
50 ...D GETDT^GMRCSTU(GMRCPT)
51 ...I COMPLDT<9999999,$S(GMRCDT1="ALL":1,RCVDT'<GMRCDT1&(RCVDT'>GMRCDT2):1,1:0) D
52 ....S X1=COMPLDT,X2=RCVDT D ^%DTC
53 ....S GMRCIDD=X
54 ...I GMRCIS="C" D
55 ....S GMRCRDT=$$GETRDT(GMRCPT)
56 ....I GMRCRDT]"" D
57 .....N X
58 .....S X=GMRCRDT D REGDT^GMRCU
59 .....S GMRCRDT=X
60 ..S GMRCD=0
61 ..S GMRCD=$O(^GMR(123,GMRCPT,40,"B",GMRCD))
62 ..I GMRCD]"" D
63 ...S GMRCDA=""
64 ...S GMRCDA=$O(^GMR(123,+GMRCPT,40,"B",GMRCD,GMRCDA))
65 ..S GMRCDLA=$E($P($G(^GMR(123.1,+$P(GMRCD(0),"^",13),0)),"^"),1,19)
66 ..S GMRCLOC=$P(GMRCD(0),"^",4)
67 ..S:$L(GMRCLOC) GMRCLOC=$P($G(^SC(GMRCLOC,0)),"^",1) ;DBIA#10040
68 ..I '$L(GMRCLOC),$P(GMRCD(0),U,21) D
69 ...S GMRCLOC=$$GET1^DIQ(4,$P(GMRCD(0),U,21),.01)
70 ..I '$L(GMRCLOC),$P(GMRCD(0),U,23) D
71 ...S GMRCLOC=$$GET1^DIQ(4,$P(GMRCD(0),U,23),.01)
72 ..I GMRCARRN="IFC",$L(GMRCLOC) D
73 ...S GMRCLOC=$E(GMRCLOC,1,23)
74 ..I ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=0 D
75 ...S GMRCCT=GMRCCT+1
76 ...S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP
77 ...S GMRCCT=GMRCCT+1
78 ...S TEMP="SERVICE: "_GMRCSVCP
79 ...S:GMRCSVCG>0 TEMP=TEMP_" in Group: "_$P(^GMR(123.5,GMRCSVCG,0),"^",1)
80 ...S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_TEMP
81 ...S NUMCLIN=NUMCLIN+1
82 ..S LINETEMP=""
83CTRL ..I GMRCCTRL#100\10 D
84 ...I GMRCCTRL#100\10=1 D
85 ....S GMRCLINE=GMRCLINE+1
86 ....S ^TMP("GMRCRINDEX",$J,GMRCLINE)=GMRCPT
87 ....S LINETEMP=$J(GMRCLINE,4)_" "
88 ...E S LINETEMP=$J(GMRCPT,9)_" "
89 ..I GMRCCTRL#2 S LINETEMP=GMRCPT_"^"_LINETEMP
90 ..I GMRCCTRL#1000\100 D
91 ...S STS=$$STATABBR^GMRCSTL1(STATUS)
92 ...S STS=STS_$J("",4-$L(STS)+1)
93 ..E D
94 ...S STS=$$STATNAME^GMRCSTL1(STATUS)
95 ...S STS=STS_$J("",10-$L(STS)+1)
96 ..S GMRCCT=GMRCCT+1
97 ..S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=LINETEMP_STS_GMRCDLA_$J("",20-$L(GMRCDLA))_GMRCDT_" "_GMRCPTN_" "_GMRCPTSN_$J("",12-$L(GMRCPTN)+5)_GMRCLOC
98 ..; IF Consults
99 ..I GMRCARRN="IFC" D
100 ...S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)_$J("",25-$L(GMRCLOC))_GMRCIRFN_$J("",17-$L(GMRCIRFN))_" "_GMRCIDD_$J("",9-$L(GMRCIDD))_" "_GMRCRDT
101 ...S ^TMP("GMRCTOT",$J,1,GMRCSVC,"F",GMRCIRFN)=^TMP("GMRCTOT",$J,1,GMRCSVC,"F",GMRCIRFN)+1
102 ...I GMRCIDD'="N/A" D
103 ....S $P(GMRCST(1,GMRCSVC,GMRCIRFN),"^")=$P(GMRCST(1,GMRCSVC,GMRCIRFN),"^")+GMRCIDD
104 ....S $P(GMRCST(1,GMRCSVC,GMRCIRFN),"^",2)=$P(GMRCST(1,GMRCSVC,GMRCIRFN),"^",2)+1
105 ....S $P(GMRCST(1,GMRCSVC),"^")=$P(GMRCST(1,GMRCSVC),"^")+GMRCIDD
106 ....S $P(GMRCST(1,GMRCSVC),"^",2)=$P(GMRCST(1,GMRCSVC),"^",2)+1
107 ..;
108ADDTOT ..;Add to totals
109 ..; for all status for this service
110 ..S ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=^TMP("GMRCTOT",$J,1,GMRCSVC,"T")+1
111 ..; pending for this service
112 ..S:",3,4,5,6,8,9,11,99,"[(","_STATUS_",") ^TMP("GMRCTOT",$J,1,GMRCSVC,"P")=^TMP("GMRCTOT",$J,1,GMRCSVC,"P")+1
113 ..; this status (STATUS) for this service
114 ..S ^TMP("GMRCTOT",$J,1,GMRCSVC,STATUS)=^TMP("GMRCTOT",$J,1,GMRCSVC,STATUS)+1
115 ; this status (STATUS) for services to all of its groupers
116 F GRP=GROUPER:-1:1 S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),STATUS)=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),STATUS))+^TMP("GMRCTOT",$J,1,GMRCSVC,STATUS)
117 Q
118 ;
119GETRDT(GMRCPT) ;get the received date
120 ; Input:
121 ; GMRCPT = File #123 IEN
122 ; Output:
123 ; GMRCRDT = Date of action entry for remote request received/received
124 N GMRCCKR,GMRCRDT,ND
125 S (GMRCCKR,ND)=0,GMRCRDT=""
126 F S ND=$O(^GMR(123,GMRCPT,40,ND)) Q:ND'>0!GMRCCKR D
127 .I $P(^GMR(123,GMRCPT,40,ND,0),"^",2)=23 D
128 ..S GMRCRDT=$P(^GMR(123,GMRCPT,40,ND,0),"^"),GMRCCKR=1
129 .I $P(^GMR(123,GMRCPT,40,ND,0),"^",2)=21 D
130 ..S GMRCRDT=$P(^GMR(123,GMRCPT,40,ND,0),"^")
131 Q GMRCRDT
Note: See TracBrowser for help on using the repository browser.