- GMRACMR1 ;HIRMFO/WAA-Find clinics and wards ;12/16/97 10:35
- ;;4.0;Adverse Reaction Tracking;**9**;Mar 29, 1996
- MDIC() ; FUNTION RETURNS S ^TMP($J,"GMRAWC",GMRANUM,GMRAX)=""
- ; FUNCTION VALUE IS -1 IF USER ABORTS, 0 IF NO LOCS PICKED, ELSE 1
- N DIC,MDIC,NEG,X,Y K GMRANLOC,^TMP($J,"GMRAWC") S GMRANUM=0
- DIC W !,$S('$D(^TMP($J,"GMRAWC")):"Select",1:"Another")_" Location: " R X:DTIME E S X="^^"
- I $$UP^XLFSTR(X)="ALL" D G:X="" DIC
- .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)
- .I %=2 K % Q
- .I %=1 K % S X=0 F S X=$O(^SC(X)) Q:X<1 D
- ..I $$SCRIACT^GMRACMR1(X) S ^TMP($J,"GMRAWC",X)=$P($G(^SC(X,0)),U,3)
- ..Q
- .K % S X=""
- .Q
- RETURN I "^^"[X S MDIC=$S(X["^":-1,1:$D(^TMP($J,"GMRAWC"))) Q MDIC
- I X?1"?".E D HLP S:Y<0 X="^^" G:Y<0 RETURN S X="?"
- 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
- I 'NEG S GMRANUM=GMRANUM+1,^TMP($J,"GMRAWC",+Y)=$P(^SC(+Y,0),U,3)
- E K ^TMP($J,"GMRAWC",+Y)
- G DIC
- HLP ; PRINT LOCATIONS SELECTED ALREADY
- W $C(7) I $D(^TMP($J,"GMRAWC")) W !?3,"YOU HAVE ALREADY SELECTED: "
- 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
- Q:Y<0
- 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."
- W !?4,"You may enter the word ALL to select all appropriate locations."
- Q
- SCRIACT(X) ; GIVEN X AS 44 ENTRY, THIS SCREEN WILL DETERMINE IF IT IS
- ; ACTIVE OR NOT FOR THIS REPORT. RETURNS 0 IF IT IS NOT, ELSE 1
- S X("ANS")=0,X(0)=$G(^SC(X,0))
- I X(0)'="" D
- .I GMRAQST'[$P(X(0),U,3) Q
- .I $P(X(0),U,3)="W" D
- ..S GMRA42=+$G(^SC(X,42)) Q:GMRA42=""!($G(^DIC(42,GMRA42,0))="")
- ..I '$O(^DIC(42,GMRA42,"OOS",0)) S X("ANS")=1 Q
- ..I GMRASEL["1" S X("ANS")=$$ACT42(DT,DT)
- ..I 'X("ANS"),GMRASEL["3" S X("ANS")=$$ACT42(GMRAST,GMRAED)
- ..Q
- .I GMRASEL["2","^C^M^"[(U_$P(X(0),U,3)_U) D
- ..S X("I")=$G(^SC(X,"I"))
- ..I $P(X("I"),U)]"",$P(X("I"),U)<$S(GMRASEL["2"!(GMRASEL["3"):GMRAST,1:DT) D Q
- ...Q:$P(X("I"),U,2)=""!(GMRASEL'["2"&(GMRASEL'["3"))
- ...Q:$P(X("I"),U,2)'=""&($P(X("I"),U,2)'<GMRAED)
- ...S X("ANS")=1
- ...Q
- ..S X("ANS")=1
- ..Q
- .Q
- Q X("ANS")
- ACT42(START,END) ; DETERMINES IF A WARD IS ACTIVE DURING A D/T RANGE
- ; WARD IS IN GMRA42, AND PASS IN START AND END AS D/T RANGE
- N ANS,OOS
- S ANS(0)=0,ANS=1,OOS(1)=9999999-(START+.000001) ;**NEW CODE RM-5/24/93
- F S OOS(1)=$O(^DIC(42,GMRA42,"OOS","AINV",OOS(1))) Q:OOS(1)<1 D Q:ANS(0)
- .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)
- ..S OOS=$G(^DIC(42,GMRA42,"OOS",OOS(2),0)) Q:OOS=""
- ..I '$P(OOS,U,6) Q
- ..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
- ..Q
- .Q
- Q ANS
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRACMR1 2988 printed Feb 18, 2025@23:05:07 Page 2
- GMRACMR1 ;HIRMFO/WAA-Find clinics and wards ;12/16/97 10:35
- +1 ;;4.0;Adverse Reaction Tracking;**9**;Mar 29, 1996
- MDIC() ; FUNTION RETURNS S ^TMP($J,"GMRAWC",GMRANUM,GMRAX)=""
- +1 ; FUNCTION VALUE IS -1 IF USER ABORTS, 0 IF NO LOCS PICKED, ELSE 1
- +2 NEW DIC,MDIC,NEG,X,Y
- KILL GMRANLOC,^TMP($JOB,"GMRAWC")
- SET GMRANUM=0
- DIC WRITE !,$SELECT('$DATA(^TMP($JOB,"GMRAWC")):"Select",1:"Another")_" Location: "
- READ X:DTIME
- IF '$TEST
- SET X="^^"
- +1 IF $$UP^XLFSTR(X)="ALL"
- Begin DoDot:1
- +2 FOR
- SET %=1
- WRITE !,"Do you mean ALL Locations"
- DO YN^DICN
- if %=-1
- SET X="^"
- SET %=2
- if %
- QUIT
- WRITE !,"Enter Y for yes you mean ALL or N for no.",$CHAR(7)
- +3 IF %=2
- KILL %
- QUIT
- +4 IF %=1
- KILL %
- SET X=0
- FOR
- SET X=$ORDER(^SC(X))
- if X<1
- QUIT
- Begin DoDot:2
- +5 IF $$SCRIACT^GMRACMR1(X)
- SET ^TMP($JOB,"GMRAWC",X)=$PIECE($GET(^SC(X,0)),U,3)
- +6 QUIT
- End DoDot:2
- +7 KILL %
- SET X=""
- +8 QUIT
- End DoDot:1
- if X=""
- GOTO DIC
- RETURN IF "^^"[X
- SET MDIC=$SELECT(X["^":-1,1:$DATA(^TMP($JOB,"GMRAWC")))
- QUIT MDIC
- +1 IF X?1"?".E
- DO HLP
- if Y<0
- SET X="^^"
- if Y<0
- GOTO RETURN
- SET X="?"
- +2 SET NEG=X?1"-".E
- SET X=$EXTRACT(X,NEG+1,$LENGTH(X))
- SET DIC="^SC("
- SET DIC(0)="EQMZ"
- SET DIC("S")="I $$SCRIACT^GMRACMR1(+Y)"
- DO ^DIC
- KILL DIC,DLAYGO
- IF +Y'>0
- GOTO DIC
- +3 IF 'NEG
- SET GMRANUM=GMRANUM+1
- SET ^TMP($JOB,"GMRAWC",+Y)=$PIECE(^SC(+Y,0),U,3)
- +4 IF '$TEST
- KILL ^TMP($JOB,"GMRAWC",+Y)
- +5 GOTO DIC
- HLP ; PRINT LOCATIONS SELECTED ALREADY
- +1 WRITE $CHAR(7)
- IF $DATA(^TMP($JOB,"GMRAWC"))
- WRITE !?3,"YOU HAVE ALREADY SELECTED: "
- +2 SET Y=""
- SET X=0
- FOR
- SET Y=$ORDER(^TMP($JOB,"GMRAWC",+Y))
- if Y=""
- QUIT
- WRITE !?5,$PIECE(^SC(+Y,0),U)
- SET X=X+1
- IF X>5
- WRITE !,"""^"" TO STOP: "
- READ X:DTIME
- if '$TEST
- SET X="^^"
- if X="^^"
- SET Y=-1
- if X="^"!(Y<0)
- QUIT
- SET X=0
- +3 if Y<0
- QUIT
- +4 WRITE !!?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."
- +5 WRITE !?4,"You may enter the word ALL to select all appropriate locations."
- +6 QUIT
- SCRIACT(X) ; GIVEN X AS 44 ENTRY, THIS SCREEN WILL DETERMINE IF IT IS
- +1 ; ACTIVE OR NOT FOR THIS REPORT. RETURNS 0 IF IT IS NOT, ELSE 1
- +2 SET X("ANS")=0
- SET X(0)=$GET(^SC(X,0))
- +3 IF X(0)'=""
- Begin DoDot:1
- +4 IF GMRAQST'[$PIECE(X(0),U,3)
- QUIT
- +5 IF $PIECE(X(0),U,3)="W"
- Begin DoDot:2
- +6 SET GMRA42=+$GET(^SC(X,42))
- if GMRA42=""!($GET(^DIC(42,GMRA42,0))="")
- QUIT
- +7 IF '$ORDER(^DIC(42,GMRA42,"OOS",0))
- SET X("ANS")=1
- QUIT
- +8 IF GMRASEL["1"
- SET X("ANS")=$$ACT42(DT,DT)
- +9 IF 'X("ANS")
- IF GMRASEL["3"
- SET X("ANS")=$$ACT42(GMRAST,GMRAED)
- +10 QUIT
- End DoDot:2
- +11 IF GMRASEL["2"
- IF "^C^M^"[(U_$PIECE(X(0),U,3)_U)
- Begin DoDot:2
- +12 SET X("I")=$GET(^SC(X,"I"))
- +13 IF $PIECE(X("I"),U)]""
- IF $PIECE(X("I"),U)<$SELECT(GMRASEL["2"!(GMRASEL["3"):GMRAST,1:DT)
- Begin DoDot:3
- +14 if $PIECE(X("I"),U,2)=""!(GMRASEL'["2"&(GMRASEL'["3"))
- QUIT
- +15 if $PIECE(X("I"),U,2)'=""&($PIECE(X("I"),U,2)'<GMRAED)
- QUIT
- +16 SET X("ANS")=1
- +17 QUIT
- End DoDot:3
- QUIT
- +18 SET X("ANS")=1
- +19 QUIT
- End DoDot:2
- +20 QUIT
- End DoDot:1
- +21 QUIT X("ANS")
- ACT42(START,END) ; DETERMINES IF A WARD IS ACTIVE DURING A D/T RANGE
- +1 ; WARD IS IN GMRA42, AND PASS IN START AND END AS D/T RANGE
- +2 NEW ANS,OOS
- +3 ;**NEW CODE RM-5/24/93
- SET ANS(0)=0
- SET ANS=1
- SET OOS(1)=9999999-(START+.000001)
- +4 FOR
- SET OOS(1)=$ORDER(^DIC(42,GMRA42,"OOS","AINV",OOS(1)))
- if OOS(1)<1
- QUIT
- Begin DoDot:1
- +5 SET OOS(2)=0
- FOR
- SET OOS(2)=$ORDER(^DIC(42,GMRA42,"OOS","AINV",OOS(1),OOS(2)))
- if OOS(2)<1
- QUIT
- Begin DoDot:2
- +6 SET OOS=$GET(^DIC(42,GMRA42,"OOS",OOS(2),0))
- if OOS=""
- QUIT
- +7 IF '$PIECE(OOS,U,6)
- QUIT
- +8 ;**NEW CODE RM-5/24/93
- SET ANS(0)=1
- SET ANS=0
- IF $SELECT($PIECE(OOS,U,4)="":0,1:$PIECE(OOS,U,4)<END)
- SET ANS=1
- +9 QUIT
- End DoDot:2
- if ANS(0)
- QUIT
- +10 QUIT
- End DoDot:1
- if ANS(0)
- QUIT
- +11 QUIT ANS
