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

GMRAOR5.m

Go to the documentation of this file. 
  1. GMRAOR5 ;HIRMFO/WAA,FPT-OERR HL7 UTILITY ;3/5/04  14:02
  1.  ;;4.0;Adverse Reaction Tracking;**4,12,13,19**;Mar 29, 1996
  1.  ;MSG = HL7 Message array
  1.  ;GMRANODE = IEN of MSG array
  1.  ;GMRAND = Date from MSG(GMRANODE)
  1.  ;GMRAMTP = Message type
  1.  ;Allergy Loader
  1.  ;building GMRAL Array to be used to stuff only new data
  1.  ;GMRAID=sequence number of allergy
  1.  ;~=continuation
  1.  ;GMRAIDO = Sequence # OBSERVED
  1.  ;GMRAIDS = Sequence # SIGN
  1.  ;GMRAIDN = Sequence # NOTES
  1.  ;   GMRADFN=DFN of patient in ^DPT(DFN) Patient (2) file
  1.  ;   GMRAL(GMRAID)=type^file ien^VA Free text drug^file^OERR entry date
  1.  ;                 ^NKA Status^Originator Pt to 200^Observed/Historical
  1.  ;   GMRAL(GMRAID,"O",GMRAIDO)=Observed date^Severity^Observer's DUZ
  1.  ;   GMRAL(GMRAID,"S",GMRAIDS)=IEN of file^Free Text of entry^File of SS
  1.  ;                             ^Date/Time of the SS
  1.  ;   GMRAL(GMRAID,"N",GMRAIDN)=Source of comments(Originator always)
  1.  ;----------------------------------------------------------------------
  1.  ;             Example of data
  1.  ;   GMRADFN=270
  1.  ;   GMRAL(1)="D^5^SHELL FISH^99ALL^2940415.06^n^1270^o"
  1.  ;   GMRAL(1,"O",1)="2940401.1^3^1234"
  1.  ;   GMRAL(1,"S",1)="32^SEVERE RASH^99ALS^2951211.1120"
  1.  ;   GMRAL(1,"N",1)="n"
  1.  ;   GMRAL(1,"N",1,1)=FREE TEXT
  1.  ;******************************************************************
  1. EN1 ;Main entry point to file data
  1.  N %,GMRADUP,GMRAFDN,GMRANKA,GNRAY,X,Y
  1.  Q:'$G(GMRADFN)
  1.  S GMRAL=0
  1.  S GMRAPA=0,GMRADUP=0
  1.  ; See if the patient has been ask about allergies
  1.  S (GMRAYN,GMRANKA)=0,GMRAYN=$P($G(^GMR(120.86,GMRADFN,0)),U,2)
  1.  ;Loop through for each allergy
  1.  F  S GMRAL=$O(GMRAL(GMRAL)) Q:GMRAL<1  D
  1.  .;If GMRANKA="" add the entry into the file
  1.  .I '$D(^GMR(120.86,GMRADFN,0)) K DD,DO,DIC,DINUM,DLAYGO S DIC="^GMR(120.86,",DLAYGO=120.86,DIC(0)="L",(DINUM,X)=GMRADFN D FILE^DICN K DD,DO,DIC,DINUM,DLAYGO D
  1.  ..Q:Y=-1
  1.  ..S GMRAYN=$S($P(GMRAL(GMRAL),U,6)="y":1,1:0)
  1.  ..S $P(^GMR(120.86,GMRADFN,0),U,2,4)=GMRAYN_U_$P(GMRAL(GMRAL),U,7)_U_$P(GMRAL(GMRAL),U,5)
  1.  ..Q
  1.  .N GMRALL,GMRAFN,%
  1.  .S GMRALL=$P(GMRAL(GMRAL),U,3)
  1.  .I $P(GMRAL(GMRAL),U,6)="n" D  Q:GMRALL'=""
  1.  ..; Change to no for allergies
  1.  ..Q:GMRAYN="1"!$D(^GMR(120.86,GMRADFN,0))
  1.  ..S $P(^GMR(120.86,GMRADFN,0),U,2,4)="0"_U_$P(GMRAL(GMRAL),U,7)_U_$P(GMRAL(GMRAL),U,5)
  1.  ..S:'$D(^GMR(120.86,"B",GMRADFN,GMRADFN)) ^(GMRADFN)=""
  1.  ..Q
  1.  .I GMRAYN="0",$P(GMRAL(GMRAL),U,6)="n" Q
  1.  .; see If the entry needs to be added
  1.  .; If the entry is an allergy set 120.86 to "y"
  1.  .I GMRALL'="",$D(^GMR(120.86,GMRADFN,0)) S GMRAYN=1 D
  1.  ..; Change to yes for allergies
  1.  ..S $P(^GMR(120.86,GMRADFN,0),U,2,4)=GMRAYN_U_$P(GMRAL(GMRAL),U,7)_U_$P(GMRAL(GMRAL),U,5)
  1.  ..S:'$D(^GMR(120.86,"B",GMRADFN,GMRADFN)) ^(GMRADFN)=""
  1.  ..Q
  1.  .; Quit if the reaction is a Dup
  1.  .Q:$$DUPCHK^GMRAOR0(GMRADFN,GMRALL)>0
  1.  .S GMRAPA=0
  1.  .K DD,DO,DIC,DINUM,DLAYGO S DIC="^GMR(120.8,",DLAYGO=120.8,DIC(0)="L",X=GMRADFN D FILE^DICN
  1.  .K DD,DO,DIC,DINUM,DLAYGO
  1.  .Q:Y=-1  S GMRAPA=+Y
  1.  .Q:$G(^GMR(120.8,GMRAPA,0))=""
  1.  .F  Q:$$LOCK^GMRAUTL(120.8,GMRAPA)
  1.  .N GMRALN,GMRAVR
  1.  .S GMRALN=$G(^GMR(120.8,GMRAPA,0))
  1.  .S $P(GMRALN,U,4)=$P(GMRAL(GMRAL),U,5) ; Orig. DT
  1.  .S $P(GMRALN,U,5)=$P(GMRAL(GMRAL),U,7) ; Originator
  1.  .S %=$P(GMRAL(GMRAL),U,4),%=$S(%="99ALL"!(%="99OTH"):"GMRD(120.82,",%="99NDF":$P($$NDFREF^GMRAOR,U,2),%="99PSC":"PS(50.605,",1:"") Q:%=""  ;Bad entry
  1.  .S:$P(GMRAL(GMRAL),U,2)="NOS" $P(GMRAL(GMRAL),U,2)=$S($O(^GMRD(120.82,"B","OTHER ALLERGY/ADVERSE REACTION",0))>0:$O(^GMRD(120.82,"B","OTHER ALLERGY/ADVERSE REACTION",0)),1:1)
  1.  .S GMRAAR=$P(GMRAL(GMRAL),U,2)_";"_%,$P(GMRALN,U,3)=GMRAAR ;File Ptr
  1.  .I $P(GMRAL(GMRAL),U,3)'="" S $P(GMRALN,U,2)=$P(GMRAL(GMRAL),U,3) ;Free text
  1.  .E  D  ; This code will resolve the free text pointer for the reaction
  1.  ..N GMRALOC,GMRADATA
  1.  ..S GMRALOC="^"_$P($P(GMRALN,U,3),";",2)_+$P(GMRALN,U,3)_",0)"
  1.  ..S GMRADATA=@GMRALOC
  1.  ..S $P(GMRALN,U,2)=$P(GMRADATA,U)
  1.  ..Q
  1.  .S $P(GMRALN,U,20)=$P(GMRAL(GMRAL),U) ;Type of reaction
  1.  .S $P(GMRALN,U,6)=$P(GMRAL(GMRAL),U,8) ;Obs/Hist
  1.  .S $P(GMRALN,U,14)="U" ;Mechanism
  1.  .S $P(GMRALN,U,12)=1 ;Sign-off the reaction
  1.  .; auto-verify?
  1.  .S GMRAVR="",GMRAVR(0)=GMRALN
  1.  .S $P(GMRALN,U,16)=$$VFY^GMRASIGN(.GMRAVR)
  1.  .I $P(GMRALN,U,16) S $P(GMRALN,U,17)=$$NOW^XLFDT
  1.  .; save
  1.  .S ^GMR(120.8,GMRAPA,0)=GMRALN
  1.  .I $D(GMRAL(GMRAL,"S",1)) D SIGN^GMRAOR6(120.8,GMRAPA,.GMRAL) ; S/S
  1.  .; Comments
  1.  .I $D(GMRAL(GMRAL,"N",1)) D COMM^GMRAOR8(GMRAPA,.GMRAL) ; Add comments
  1.  .D EN1^GMRAOR9 K GMRAAR ;stuff ingredients & classes
  1.  .;Re-Index Whole file entry
  1.  .K DIK,DA S DIK="^GMR(120.8,",DA=GMRAPA D IX^DIK K DIK,DA
  1.  .D UNLOCK^GMRAUTL(120.8,GMRAPA)
  1.  .S ^TMP($J,"GMRASF",1,GMRAPA)="" D RANGE^GMRASIGN(1) ;**19  Send bulletins upon signing-off
  1.  .S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0)) D VAD^GMRAUTL1($P(^GMR(120.8,GMRAPA,0),U),"",.GMRALOC,.GMRANAM,"",.GMRASSN),BULLT^GMRASEND ;19 Send mark chart bulletin
  1.  .Q:($P(GMRAL(GMRAL),U,1)'["D"!($P(GMRAL(GMRAL),U,8)'["o"))  ;quit if not an observed drug reaction
  1.  .; add Adverse Reaction report.
  1.  .I $G(GMRAL(GMRAL,"O",1))'="" D ADVERSE^GMRAOR7(GMRAPA,.GMRAL)
  1.  .Q
  1.  Q