GMRAPL ;HIRMFO/WAA- PRINT ALLERGY LIST BY LOCATION ;5/2/97 14:13
;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5
EN1 ; This routine will loop through the GMRA patient allergy file
; to find all patient within the date range that meet the criteria
; and then display all the data for those patients first by location
; then by date/time range of the reaction.
; First select a starting date.
; then select an end date.
; then select a print device.
; GMAST = START DATE
; GMAEN = END DATE
;
S GMRAOUT=0
D DT G:GMRAOUT EXIT
S GMAPG=1
D DEVICE
D EXIT
Q
GET ; This sub routine is to find all the reaction with in this observed
; date range.
K ^TMP($J,"GMRAPL")
N GMADT S GMADT=GMAST-.0001
F S GMADT=$O(^GMR(120.8,"AODT",GMADT)) Q:GMADT<1 Q:GMADT>GMAEN D
.N GMRAPA S GMRAPA=0
.F S GMRAPA=$O(^GMR(120.8,"AODT",GMADT,GMRAPA)) Q:GMRAPA<1 D
..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
..; Stop if it is not Signed or if is E/E
..Q:GMRAPA(0)="" ; Bad Zero node
..Q:'$P(GMRAPA(0),U,12) ; Not signed off
..Q:$P($G(^GMR(120.8,GMRAPA,"ER")),U) ; Entered in error
..; Get patient name and location.
..S GMRATYP=$P(GMRAPA(0),U,20) ; Get the reaction types FDO
..S (GMRANAM,GMRALOC,GMRAVIP)=""
..Q:'$$PRDTST^GMRAUTL1($P($G(GMRAPA(0)),U)) ;GMRA*4*33 Exclude test patient from report if production or legacy environment
..D VAD^GMRAUTL1($P(GMRAPA(0),U),$P(GMRAPA(0),U,4),.GMRALOC,.GMRANAM,"","","","",.GMRAVIP)
..I GMRALOC'="",+$G(^DIC(42,GMRALOC,44)) S GMRALOC=$P($G(^SC(+$G(^DIC(42,GMRALOC,44)),0)),U)
..I GMRALOC="" S GMRALOC="Out Patients"
..;Data format is as follows....
..;^TMP($J,"GMRAPL",Ward location,Patient,PID,Reaction Type(FDO),Reaction)
..S ^TMP($J,"GMRAPL",$E(GMRALOC,1,30),$E(GMRANAM,1,30),GMRAVIP,GMRATYP,GMRAPA)=""
..Q
.Q
Q
PRINT ; Print data in the reaction global
I $E(IOST,1)="C" W !,"One moment please...",!
D GET
S GMRALOC="" F S GMRALOC=$O(^TMP($J,"GMRAPL",GMRALOC)) Q:GMRALOC="" D Q:GMRAOUT
.D HEAD Q:GMRAOUT
.S GMRANAM="" F S GMRANAM=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM)) Q:GMRANAM="" D Q:GMRAOUT
..S GMRAVIP="" F S GMRAVIP=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP)) Q:GMRAVIP="" D Q:GMRAOUT
...I $Y>(IOSL-4) D HEAD Q:GMRAOUT
...W !,?10,"Patient: ",GMRANAM," (",GMRAVIP,")"
...S GMRATYP="" F S GMRATYP=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP)) W:GMRATYP="" ! Q:GMRATYP="" D Q:GMRAOUT
....S GMRAPA=0 F S GMRAPA=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP,GMRAPA)) Q:GMRAPA<1 D Q:GMRAOUT
.....S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
.....W !,$$FMTE^XLFDT($P(GMRAPA(0),U,4),"1") ;When It was entered
.....W ?20,$S($P(GMRAPA(0),U,5)'="":$E($P(^VA(200,$P(GMRAPA(0),U,5),0),U),1,25),1:"<None>") ;Who Entered it
.....W ?46,GMRATYP ;Type of reaction
.....W ?50,$E($P(GMRAPA(0),U,2),1,30) ;Reaction
.....I $Y>(IOSL-4) D HEAD
.....Q
....Q
...Q
..Q
.Q
Q
HEAD ; Header
I $E(IOST,1)="C" D Q:GMRAOUT
.I GMAPG=1 W @IOF Q
.I GMAPG'=1 D Q:GMRAOUT
..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
..K Y
..Q
.Q
I GMAPG'=1 W @IOF
W $$FMTE^XLFDT(GMRAPDT,"1"),?70,"Page: ",GMAPG S GMAPG=GMAPG+1
W !,?11,"List all Signed Patient Reactions for",$S(GMRALOC'="Out Patients":" Ward Location ",1:" "),GMRALOC
W !,?15,"From ",$$FMTE^XLFDT(GMAST,"1")," to ",$$FMTE^XLFDT(GMAEN,"1")
W !,"Date",?20,"Originator",?45,"Type",?50,"Causative Agent"
W !,$$REPEAT^XLFSTR("-",79)
Q
DEVICE ; Select a device to print on
D NOW^%DTC S GMRAPDT=X
W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
I $D(IO("Q")) D Q
. S ZTRTN="PRINT^GMRAPL",(ZTSAVE("GMAST"),ZTSAVE("GMAEN"),ZTSAVE("GMRAOUT"),ZTSAVE("GMRAPDT"),ZTSAVE("GMAPG"))=""
. S ZTDESC="List of Reactions by Ward Location within a date range." D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
. Q
U IO D PRINT U IO(0)
D CLOSE^GMRAUTL
D EXIT
Q
DT ; Get dates
S GMAST=$$DATE("Enter Start Date: ") I GMAST<1 S GMRAOUT=1 Q
S GMAEN=$$DATE("Enter Ending Date: ",GMAST) I GMAEN<1 S GMRAOUT=1 Q
S GMAEN=GMAEN_".24" ;Gives results through entire day when 'T' is selected
Q
DATE(PROMPT,GMADATE) ; Date sub routine
S GMADATE=$G(GMADATE)
S DATE=""
N DIR
S DIR(0)="DAO^"_GMADATE_"::AEP",DIR("A")=PROMPT
D ^DIR I $D(DIRUT) S DATE="" Q DATE
S DATE=Y
Q DATE
EXIT ;EXIT ROUTINE DATA
K ^TMP($J,"GMRAPL")
D KILL^XUSCLEAN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPL 4468 printed Sep 02, 2024@18:25:34 Page 2
GMRAPL ;HIRMFO/WAA- PRINT ALLERGY LIST BY LOCATION ;5/2/97 14:13
+1 ;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5
EN1 ; This routine will loop through the GMRA patient allergy file
+1 ; to find all patient within the date range that meet the criteria
+2 ; and then display all the data for those patients first by location
+3 ; then by date/time range of the reaction.
+4 ; First select a starting date.
+5 ; then select an end date.
+6 ; then select a print device.
+7 ; GMAST = START DATE
+8 ; GMAEN = END DATE
+9 ;
+10 SET GMRAOUT=0
+11 DO DT
if GMRAOUT
GOTO EXIT
+12 SET GMAPG=1
+13 DO DEVICE
+14 DO EXIT
+15 QUIT
GET ; This sub routine is to find all the reaction with in this observed
+1 ; date range.
+2 KILL ^TMP($JOB,"GMRAPL")
+3 NEW GMADT
SET GMADT=GMAST-.0001
+4 FOR
SET GMADT=$ORDER(^GMR(120.8,"AODT",GMADT))
if GMADT<1
QUIT
if GMADT>GMAEN
QUIT
Begin DoDot:1
+5 NEW GMRAPA
SET GMRAPA=0
+6 FOR
SET GMRAPA=$ORDER(^GMR(120.8,"AODT",GMADT,GMRAPA))
if GMRAPA<1
QUIT
Begin DoDot:2
+7 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
+8 ; Stop if it is not Signed or if is E/E
+9 ; Bad Zero node
if GMRAPA(0)=""
QUIT
+10 ; Not signed off
if '$PIECE(GMRAPA(0),U,12)
QUIT
+11 ; Entered in error
if $PIECE($GET(^GMR(120.8,GMRAPA,"ER")),U)
QUIT
+12 ; Get patient name and location.
+13 ; Get the reaction types FDO
SET GMRATYP=$PIECE(GMRAPA(0),U,20)
+14 SET (GMRANAM,GMRALOC,GMRAVIP)=""
+15 ;GMRA*4*33 Exclude test patient from report if production or legacy environment
if '$$PRDTST^GMRAUTL1($PIECE($GET(GMRAPA(0)),U))
QUIT
+16 DO VAD^GMRAUTL1($PIECE(GMRAPA(0),U),$PIECE(GMRAPA(0),U,4),.GMRALOC,.GMRANAM,"","","","",.GMRAVIP)
+17 IF GMRALOC'=""
IF +$GET(^DIC(42,GMRALOC,44))
SET GMRALOC=$PIECE($GET(^SC(+$GET(^DIC(42,GMRALOC,44)),0)),U)
+18 IF GMRALOC=""
SET GMRALOC="Out Patients"
+19 ;Data format is as follows....
+20 ;^TMP($J,"GMRAPL",Ward location,Patient,PID,Reaction Type(FDO),Reaction)
+21 SET ^TMP($JOB,"GMRAPL",$EXTRACT(GMRALOC,1,30),$EXTRACT(GMRANAM,1,30),GMRAVIP,GMRATYP,GMRAPA)=""
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 QUIT
PRINT ; Print data in the reaction global
+1 IF $EXTRACT(IOST,1)="C"
WRITE !,"One moment please...",!
+2 DO GET
+3 SET GMRALOC=""
FOR
SET GMRALOC=$ORDER(^TMP($JOB,"GMRAPL",GMRALOC))
if GMRALOC=""
QUIT
Begin DoDot:1
+4 DO HEAD
if GMRAOUT
QUIT
+5 SET GMRANAM=""
FOR
SET GMRANAM=$ORDER(^TMP($JOB,"GMRAPL",GMRALOC,GMRANAM))
if GMRANAM=""
QUIT
Begin DoDot:2
+6 SET GMRAVIP=""
FOR
SET GMRAVIP=$ORDER(^TMP($JOB,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP))
if GMRAVIP=""
QUIT
Begin DoDot:3
+7 IF $Y>(IOSL-4)
DO HEAD
if GMRAOUT
QUIT
+8 WRITE !,?10,"Patient: ",GMRANAM," (",GMRAVIP,")"
+9 SET GMRATYP=""
FOR
SET GMRATYP=$ORDER(^TMP($JOB,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP))
if GMRATYP=""
WRITE !
if GMRATYP=""
QUIT
Begin DoDot:4
+10 SET GMRAPA=0
FOR
SET GMRAPA=$ORDER(^TMP($JOB,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP,GMRAPA))
if GMRAPA<1
QUIT
Begin DoDot:5
+11 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
if GMRAPA(0)=""
QUIT
+12 ;When It was entered
WRITE !,$$FMTE^XLFDT($PIECE(GMRAPA(0),U,4),"1")
+13 ;Who Entered it
WRITE ?20,$SELECT($PIECE(GMRAPA(0),U,5)'="":$EXTRACT($PIECE(^VA(200,$PIECE(GMRAPA(0),U,5),0),U),1,25),1:"<None>")
+14 ;Type of reaction
WRITE ?46,GMRATYP
+15 ;Reaction
WRITE ?50,$EXTRACT($PIECE(GMRAPA(0),U,2),1,30)
+16 IF $Y>(IOSL-4)
DO HEAD
+17 QUIT
End DoDot:5
if GMRAOUT
QUIT
+18 QUIT
End DoDot:4
if GMRAOUT
QUIT
+19 QUIT
End DoDot:3
if GMRAOUT
QUIT
+20 QUIT
End DoDot:2
if GMRAOUT
QUIT
+21 QUIT
End DoDot:1
if GMRAOUT
QUIT
+22 QUIT
HEAD ; Header
+1 IF $EXTRACT(IOST,1)="C"
Begin DoDot:1
+2 IF GMAPG=1
WRITE @IOF
QUIT
+3 IF GMAPG'=1
Begin DoDot:2
+4 NEW DIR
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET GMRAOUT=1
+5 KILL Y
+6 QUIT
End DoDot:2
if GMRAOUT
QUIT
+7 QUIT
End DoDot:1
if GMRAOUT
QUIT
+8 IF GMAPG'=1
WRITE @IOF
+9 WRITE $$FMTE^XLFDT(GMRAPDT,"1"),?70,"Page: ",GMAPG
SET GMAPG=GMAPG+1
+10 WRITE !,?11,"List all Signed Patient Reactions for",$SELECT(GMRALOC'="Out Patients":" Ward Location ",1:" "),GMRALOC
+11 WRITE !,?15,"From ",$$FMTE^XLFDT(GMAST,"1")," to ",$$FMTE^XLFDT(GMAEN,"1")
+12 WRITE !,"Date",?20,"Originator",?45,"Type",?50,"Causative Agent"
+13 WRITE !,$$REPEAT^XLFSTR("-",79)
+14 QUIT
DEVICE ; Select a device to print on
+1 DO NOW^%DTC
SET GMRAPDT=X
+2 WRITE !
KILL GMRAZIS
DO DEV^GMRAUTL
IF POP
WRITE !,"PLEASE TRY LATER"
SET GMRAOUT=1
QUIT
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 SET ZTRTN="PRINT^GMRAPL"
SET (ZTSAVE("GMAST"),ZTSAVE("GMAEN"),ZTSAVE("GMRAOUT"),ZTSAVE("GMRAPDT"),ZTSAVE("GMAPG"))=""
+5 SET ZTDESC="List of Reactions by Ward Location within a date range."
DO ^%ZTLOAD
+6 WRITE !!,$SELECT($DATA(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
+7 QUIT
End DoDot:1
QUIT
+8 USE IO
DO PRINT
USE IO(0)
+9 DO CLOSE^GMRAUTL
+10 DO EXIT
+11 QUIT
DT ; Get dates
+1 SET GMAST=$$DATE("Enter Start Date: ")
IF GMAST<1
SET GMRAOUT=1
QUIT
+2 SET GMAEN=$$DATE("Enter Ending Date: ",GMAST)
IF GMAEN<1
SET GMRAOUT=1
QUIT
+3 ;Gives results through entire day when 'T' is selected
SET GMAEN=GMAEN_".24"
+4 QUIT
DATE(PROMPT,GMADATE) ; Date sub routine
+1 SET GMADATE=$GET(GMADATE)
+2 SET DATE=""
+3 NEW DIR
+4 SET DIR(0)="DAO^"_GMADATE_"::AEP"
SET DIR("A")=PROMPT
+5 DO ^DIR
IF $DATA(DIRUT)
SET DATE=""
QUIT DATE
+6 SET DATE=Y
+7 QUIT DATE
EXIT ;EXIT ROUTINE DATA
+1 KILL ^TMP($JOB,"GMRAPL")
+2 DO KILL^XUSCLEAN
+3 QUIT
