source: FOIAVistA/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRACMR1.m@ 1582

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

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1GMRACMR1 ;HIRMFO/WAA-Find clinics and wards ;12/16/97 10:35
2 ;;4.0;Adverse Reaction Tracking;**9**;Mar 29, 1996
3MDIC() ; FUNTION RETURNS S ^TMP($J,"GMRAWC",GMRANUM,GMRAX)=""
4 ; FUNCTION VALUE IS -1 IF USER ABORTS, 0 IF NO LOCS PICKED, ELSE 1
5 N DIC,MDIC,NEG,X,Y K GMRANLOC,^TMP($J,"GMRAWC") S GMRANUM=0
6DIC W !,$S('$D(^TMP($J,"GMRAWC")):"Select",1:"Another")_" Location: " R X:DTIME E S X="^^"
7 I $$UP^XLFSTR(X)="ALL" D G:X="" DIC
8 .F S %=1 W !,"Do you mean ALL Locations" D YN^DICN S:%=-1 X="^",%=2 Q:% W !,"Enter Y for yes you mean ALL or N for no.",$C(7)
9 .I %=2 K % Q
10 .I %=1 K % S X=0 F S X=$O(^SC(X)) Q:X<1 D
11 ..I $$SCRIACT^GMRACMR1(X) S ^TMP($J,"GMRAWC",X)=$P($G(^SC(X,0)),U,3)
12 ..Q
13 .K % S X=""
14 .Q
15RETURN I "^^"[X S MDIC=$S(X["^":-1,1:$D(^TMP($J,"GMRAWC"))) Q MDIC
16 I X?1"?".E D HLP S:Y<0 X="^^" G:Y<0 RETURN S X="?"
17 S NEG=X?1"-".E,X=$E(X,NEG+1,$L(X)),DIC="^SC(",DIC(0)="EQMZ",DIC("S")="I $$SCRIACT^GMRACMR1(+Y)" D ^DIC K DIC,DLAYGO I +Y'>0 G DIC
18 I 'NEG S GMRANUM=GMRANUM+1,^TMP($J,"GMRAWC",+Y)=$P(^SC(+Y,0),U,3)
19 E K ^TMP($J,"GMRAWC",+Y)
20 G DIC
21HLP ; PRINT LOCATIONS SELECTED ALREADY
22 W $C(7) I $D(^TMP($J,"GMRAWC")) W !?3,"YOU HAVE ALREADY SELECTED: "
23 S Y="",X=0 F S Y=$O(^TMP($J,"GMRAWC",+Y)) Q:Y="" W !?5,$P(^SC(+Y,0),U) S X=X+1 I X>5 W !,"""^"" TO STOP: " R X:DTIME S:'$T X="^^" S:X="^^" Y=-1 Q:X="^"!(Y<0) S X=0
24 Q:Y<0
25 W !!?3,"You may deselect from the list by typing a '-' followed by location name.",!?4,"E.g. -3E would delete 3E from the list of locations already selected."
26 W !?4,"You may enter the word ALL to select all appropriate locations."
27 Q
28SCRIACT(X) ; GIVEN X AS 44 ENTRY, THIS SCREEN WILL DETERMINE IF IT IS
29 ; ACTIVE OR NOT FOR THIS REPORT. RETURNS 0 IF IT IS NOT, ELSE 1
30 S X("ANS")=0,X(0)=$G(^SC(X,0))
31 I X(0)'="" D
32 .I GMRAQST'[$P(X(0),U,3) Q
33 .I $P(X(0),U,3)="W" D
34 ..S GMRA42=+$G(^SC(X,42)) Q:GMRA42=""!($G(^DIC(42,GMRA42,0))="")
35 ..I '$O(^DIC(42,GMRA42,"OOS",0)) S X("ANS")=1 Q
36 ..I GMRASEL["1" S X("ANS")=$$ACT42(DT,DT)
37 ..I 'X("ANS"),GMRASEL["3" S X("ANS")=$$ACT42(GMRAST,GMRAED)
38 ..Q
39 .I GMRASEL["2","^C^M^"[(U_$P(X(0),U,3)_U) D
40 ..S X("I")=$G(^SC(X,"I"))
41 ..I $P(X("I"),U)]"",$P(X("I"),U)<$S(GMRASEL["2"!(GMRASEL["3"):GMRAST,1:DT) D Q
42 ...Q:$P(X("I"),U,2)=""!(GMRASEL'["2"&(GMRASEL'["3"))
43 ...Q:$P(X("I"),U,2)'=""&($P(X("I"),U,2)'<GMRAED)
44 ...S X("ANS")=1
45 ...Q
46 ..S X("ANS")=1
47 ..Q
48 .Q
49 Q X("ANS")
50ACT42(START,END) ; DETERMINES IF A WARD IS ACTIVE DURING A D/T RANGE
51 ; WARD IS IN GMRA42, AND PASS IN START AND END AS D/T RANGE
52 N ANS,OOS
53 S ANS(0)=0,ANS=1,OOS(1)=9999999-(START+.000001) ;**NEW CODE RM-5/24/93
54 F S OOS(1)=$O(^DIC(42,GMRA42,"OOS","AINV",OOS(1))) Q:OOS(1)<1 D Q:ANS(0)
55 .S OOS(2)=0 F S OOS(2)=$O(^DIC(42,GMRA42,"OOS","AINV",OOS(1),OOS(2))) Q:OOS(2)<1 D Q:ANS(0)
56 ..S OOS=$G(^DIC(42,GMRA42,"OOS",OOS(2),0)) Q:OOS=""
57 ..I '$P(OOS,U,6) Q
58 ..S ANS(0)=1,ANS=0 I $S($P(OOS,U,4)="":0,1:$P(OOS,U,4)<END) S ANS=1 ;**NEW CODE RM-5/24/93
59 ..Q
60 .Q
61 Q ANS
Note: See TracBrowser for help on using the repository browser.