Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRAPL

GMRAPL.m

Go to the documentation of this file.
  1. 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
  1. EN1 ; This routine will loop through the GMRA patient allergy file
  1. ; to find all patient within the date range that meet the criteria
  1. ; and then display all the data for those patients first by location
  1. ; then by date/time range of the reaction.
  1. ; First select a starting date.
  1. ; then select an end date.
  1. ; then select a print device.
  1. ; GMAST = START DATE
  1. ; GMAEN = END DATE
  1. ;
  1. S GMRAOUT=0
  1. D DT G:GMRAOUT EXIT
  1. S GMAPG=1
  1. D DEVICE
  1. D EXIT
  1. Q
  1. GET ; This sub routine is to find all the reaction with in this observed
  1. ; date range.
  1. K ^TMP($J,"GMRAPL")
  1. N GMADT S GMADT=GMAST-.0001
  1. F S GMADT=$O(^GMR(120.8,"AODT",GMADT)) Q:GMADT<1 Q:GMADT>GMAEN D
  1. .N GMRAPA S GMRAPA=0
  1. .F S GMRAPA=$O(^GMR(120.8,"AODT",GMADT,GMRAPA)) Q:GMRAPA<1 D
  1. ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
  1. ..; Stop if it is not Signed or if is E/E
  1. ..Q:GMRAPA(0)="" ; Bad Zero node
  1. ..Q:'$P(GMRAPA(0),U,12) ; Not signed off
  1. ..Q:$P($G(^GMR(120.8,GMRAPA,"ER")),U) ; Entered in error
  1. ..; Get patient name and location.
  1. ..S GMRATYP=$P(GMRAPA(0),U,20) ; Get the reaction types FDO
  1. ..S (GMRANAM,GMRALOC,GMRAVIP)=""
  1. ..Q:'$$PRDTST^GMRAUTL1($P($G(GMRAPA(0)),U)) ;GMRA*4*33 Exclude test patient from report if production or legacy environment
  1. ..D VAD^GMRAUTL1($P(GMRAPA(0),U),$P(GMRAPA(0),U,4),.GMRALOC,.GMRANAM,"","","","",.GMRAVIP)
  1. ..I GMRALOC'="",+$G(^DIC(42,GMRALOC,44)) S GMRALOC=$P($G(^SC(+$G(^DIC(42,GMRALOC,44)),0)),U)
  1. ..I GMRALOC="" S GMRALOC="Out Patients"
  1. ..;Data format is as follows....
  1. ..;^TMP($J,"GMRAPL",Ward location,Patient,PID,Reaction Type(FDO),Reaction)
  1. ..S ^TMP($J,"GMRAPL",$E(GMRALOC,1,30),$E(GMRANAM,1,30),GMRAVIP,GMRATYP,GMRAPA)=""
  1. ..Q
  1. .Q
  1. Q
  1. PRINT ; Print data in the reaction global
  1. I $E(IOST,1)="C" W !,"One moment please...",!
  1. D GET
  1. S GMRALOC="" F S GMRALOC=$O(^TMP($J,"GMRAPL",GMRALOC)) Q:GMRALOC="" D Q:GMRAOUT
  1. .D HEAD Q:GMRAOUT
  1. .S GMRANAM="" F S GMRANAM=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM)) Q:GMRANAM="" D Q:GMRAOUT
  1. ..S GMRAVIP="" F S GMRAVIP=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP)) Q:GMRAVIP="" D Q:GMRAOUT
  1. ...I $Y>(IOSL-4) D HEAD Q:GMRAOUT
  1. ...W !,?10,"Patient: ",GMRANAM," (",GMRAVIP,")"
  1. ...S GMRATYP="" F S GMRATYP=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP)) W:GMRATYP="" ! Q:GMRATYP="" D Q:GMRAOUT
  1. ....S GMRAPA=0 F S GMRAPA=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP,GMRAPA)) Q:GMRAPA<1 D Q:GMRAOUT
  1. .....S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
  1. .....W !,$$FMTE^XLFDT($P(GMRAPA(0),U,4),"1") ;When It was entered
  1. .....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
  1. .....W ?46,GMRATYP ;Type of reaction
  1. .....W ?50,$E($P(GMRAPA(0),U,2),1,30) ;Reaction
  1. .....I $Y>(IOSL-4) D HEAD
  1. .....Q
  1. ....Q
  1. ...Q
  1. ..Q
  1. .Q
  1. Q
  1. I $E(IOST,1)="C" D Q:GMRAOUT
  1. .I GMAPG=1 W @IOF Q
  1. .I GMAPG'=1 D Q:GMRAOUT
  1. ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
  1. ..K Y
  1. ..Q
  1. .Q
  1. I GMAPG'=1 W @IOF
  1. W $$FMTE^XLFDT(GMRAPDT,"1"),?70,"Page: ",GMAPG S GMAPG=GMAPG+1
  1. W !,?11,"List all Signed Patient Reactions for",$S(GMRALOC'="Out Patients":" Ward Location ",1:" "),GMRALOC
  1. W !,?15,"From ",$$FMTE^XLFDT(GMAST,"1")," to ",$$FMTE^XLFDT(GMAEN,"1")
  1. W !,"Date",?20,"Originator",?45,"Type",?50,"Causative Agent"
  1. W !,$$REPEAT^XLFSTR("-",79)
  1. Q
  1. DEVICE ; Select a device to print on
  1. D NOW^%DTC S GMRAPDT=X
  1. W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
  1. I $D(IO("Q")) D Q
  1. . S ZTRTN="PRINT^GMRAPL",(ZTSAVE("GMAST"),ZTSAVE("GMAEN"),ZTSAVE("GMRAOUT"),ZTSAVE("GMRAPDT"),ZTSAVE("GMAPG"))=""
  1. . S ZTDESC="List of Reactions by Ward Location within a date range." D ^%ZTLOAD
  1. . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
  1. . Q
  1. U IO D PRINT U IO(0)
  1. D CLOSE^GMRAUTL
  1. D EXIT
  1. Q
  1. DT ; Get dates
  1. S GMAST=$$DATE("Enter Start Date: ") I GMAST<1 S GMRAOUT=1 Q
  1. S GMAEN=$$DATE("Enter Ending Date: ",GMAST) I GMAEN<1 S GMRAOUT=1 Q
  1. S GMAEN=GMAEN_".24" ;Gives results through entire day when 'T' is selected
  1. Q
  1. DATE(PROMPT,GMADATE) ; Date sub routine
  1. S GMADATE=$G(GMADATE)
  1. S DATE=""
  1. N DIR
  1. S DIR(0)="DAO^"_GMADATE_"::AEP",DIR("A")=PROMPT
  1. D ^DIR I $D(DIRUT) S DATE="" Q DATE
  1. S DATE=Y
  1. Q DATE
  1. EXIT ;EXIT ROUTINE DATA
  1. K ^TMP($J,"GMRAPL")
  1. D KILL^XUSCLEAN
  1. Q