| [613] | 1 | GMRACMR1 ;HIRMFO/WAA-Find clinics and wards ;12/16/97 10:35
|
|---|
| 2 | ;;4.0;Adverse Reaction Tracking;**9**;Mar 29, 1996
|
|---|
| 3 | MDIC() ; 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
|
|---|
| 6 | DIC 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
|
|---|
| 15 | RETURN 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
|
|---|
| 21 | HLP ; 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
|
|---|
| 28 | SCRIACT(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")
|
|---|
| 50 | ACT42(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
|
|---|
