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

GMRAEAB.m

Go to the documentation of this file.
  1. GMRAEAB ;HIRMFO/RM-BULLETIN SEND FOR E/E REACTIONS ;12/22/04 08:57
  1. ;;4.0;Adverse Reaction Tracking;**21**;Mar 29, 1996
  1. EN1 ; SEND BULLETIN TO ALL VERIFIERS/CHART MARK GROUPS
  1. ; INDICATING A/AR NEEDS UPDATES
  1. N GMRAGRUP,%
  1. S GMRANAM="",GMRALOC="",GMRASSN=""
  1. D VAD^GMRAUTL1($P(GMRAPA(0),U),"",.GMRALOC,.GMRANAM,"",.GMRASSN)
  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 PATIENT"
  1. S XMB="GMRA ENTERED IN ERROR"
  1. ; Build XMB array
  1. S XMB(1)=GMRANAM ; Patient Name
  1. S XMB(2)=GMRASSN ; Patient SSN
  1. S XMB(3)=$P(GMRAPA(0),"^",2) ; Reaction
  1. S XMB(4)=GMRALOC ; Location
  1. S XMB(5)=$S($P(GMRAPA(0),U,5)'="":$$GET1^DIQ(200,$P(GMRAPA(0),U,5)_",",".01"),1:"<None>") ;21 Originator
  1. S XMB(6)=$$GET1^DIQ(200,$P($G(^GMR(120.8,GMRAPA,"ER")),U,3)_",",".01") ;21 Enter in error by
  1. S XMB(7)=$$FMTE^XLFDT($P($G(^GMR(120.8,GMRAPA,"ER")),U,2),1) ; Enter in error on
  1. S XMB(9)=$$FMTE^XLFDT($P(GMRAPA(0),U,4)) ;21
  1. ; Signs/symptoms and comments
  1. K ^TMP($J,"GMRACOM")
  1. N GMRAKIND,GMRACNT,GMRAX,GMRASP,GMRADATA,GMRAI,GMRAP ;21
  1. S GMRACNT=1,GMRASP=" "
  1. D EN1^GMRAOR2(GMRAPA,"GMRADATA") ;21
  1. I $D(GMRADATA("S")) S ^TMP($J,"GMRACOM",GMRACNT)=" Signs/Symptoms: " D ;21
  1. .S GMRAI=0,GMRAP=0 F S GMRAI=$O(GMRADATA("S",GMRAI)) Q:'+GMRAI D ;21
  1. ..I 'GMRAP S ^TMP($J,"GMRACOM",GMRACNT)=^TMP($J,"GMRACOM",GMRACNT)_GMRADATA("S",GMRAI),GMRACNT=GMRACNT+1,GMRAP=1 Q ;21
  1. ..S ^TMP($J,"GMRACOM",GMRACNT)=$$REPEAT^XLFSTR(" ",24)_GMRADATA("S",GMRAI),GMRACNT=GMRACNT+1 ;21
  1. I $D(^GMR(120.8,GMRAPA,26,"AVER")) S ^TMP($J,"GMRACOM",GMRACNT)="",GMRACNT=GMRACNT+1,^TMP($J,"GMRACOM",GMRACNT)="Comments:",GMRACNT=GMRACNT+1 ;21
  1. F GMRAKIND="O","V","E" S GMRAX=0 S GMRAX=$O(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND,GMRAX)) I GMRAX>0 D
  1. .S ^TMP($J,"GMRACOM",GMRACNT)=$E(GMRASP,1,5)_$S(GMRAKIND="O":"ORIGINATOR",GMRAKIND="V":"VERIFIER",GMRAKIND="E":"ENTERED IN ERROR",1:""),GMRACNT=GMRACNT+1
  1. .S GMRAX=0 F S GMRAX=$O(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND,GMRAX)) Q:GMRAX<1 D
  1. ..N GMRAY,GMRAZ
  1. ..S GMRAY=$P(^GMR(120.8,GMRAPA,26,GMRAX,0),U),GMRAZ=$P(^(0),U,2)
  1. ..D PRINT Q:GMRAOUT
  1. ..Q
  1. .Q
  1. S XMTEXT="^TMP($J,""GMRACOM"","
  1. ; Build XMY array
  1. ;Only send bulletin to verifier groups if reactant still needs to be verified or if it wasn't autoverified
  1. I '+$P(GMRAPA(0),U,16)!($P(GMRAPA(0),U,18)) F %=1:1:$L($P(GMRAPA(0),"^",20)) D ;21
  1. .S GMRAGRUP=$E($P(GMRAPA(0),"^",20),%)
  1. .S XMY("G.GMRA VERIFY "_$S(GMRAGRUP="D":"DRUG",GMRAGRUP="F":"FOOD",1:"OTHER")_" ALLERGY")=""
  1. .Q
  1. S XMY("G.GMRA MARK CHART")=""
  1. I $P(GMRAPA(0),U,20)["D"&($P(GMRAPA(0),U,6)="o") S XMY("G.GMRA P&T COMMITTEE FDA")="",XMB(8)="and FDA information " ;21
  1. D ^XMB
  1. K XMB,XMY,XMTEXT,GMRATEXT,^TMP($J,"GMRACOM")
  1. Q
  1. PRINT ;PRINT OUT THE DATA
  1. N GMRAT,GMRAZN S (GMRAZN,GMRAT)=""
  1. S:GMRAZ'="" GMRAZN=$$GET1^DIQ(200,GMRAZ_",",".01") ;21
  1. S:GMRAZ'="" GMRAT=$$GET1^DIQ(200,GMRAZ_",","8","I") ;21
  1. S:GMRAT'="" GMRAT=$P($G(^DIC(3.1,GMRAT,0)),U)
  1. S ^TMP($J,"GMRACOM",GMRACNT)=$E(GMRASP,1,10)_"Date: "_$$FMTE^XLFDT(GMRAY,1)_$E(GMRASP,1,10)_"User: "_GMRAZN,GMRACNT=GMRACNT+1
  1. S ^TMP($J,"GMRACOM",GMRACNT)=$E(GMRASP,1,47)_"Title: "_GMRAT,GMRACNT=GMRACNT+1
  1. I '$D(^GMR(120.8,GMRAPA,26,GMRAX,2,0)) Q
  1. S DIWL=16,DIWR=75,DIWF=""
  1. K ^UTILITY($J,"W",DIWL)
  1. S GMRAXX=0 F S GMRAXX=$O(^GMR(120.8,GMRAPA,26,GMRAX,2,GMRAXX)) Q:GMRAXX<1 S X=^(GMRAXX,0) D ^DIWP
  1. S GMRAXX=0 F S GMRAXX=$O(^UTILITY($J,"W",DIWL,GMRAXX)) Q:GMRAXX<1 S ^TMP($J,"GMRACOM",GMRACNT)=$E(GMRASP,1,16)_^UTILITY($J,"W",DIWL,GMRAXX,0),GMRACNT=GMRACNT+1
  1. S ^TMP($J,"GMRACOM",GMRACNT)=" ",GMRACNT=GMRACNT+1
  1. Q