- 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 Jan 18, 2025@02:41:27 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