- GMRAEAB ;HIRMFO/RM-BULLETIN SEND FOR E/E REACTIONS ;12/22/04 08:57
- ;;4.0;Adverse Reaction Tracking;**21**;Mar 29, 1996
- EN1 ; SEND BULLETIN TO ALL VERIFIERS/CHART MARK GROUPS
- ; INDICATING A/AR NEEDS UPDATES
- N GMRAGRUP,%
- S GMRANAM="",GMRALOC="",GMRASSN=""
- D VAD^GMRAUTL1($P(GMRAPA(0),U),"",.GMRALOC,.GMRANAM,"",.GMRASSN)
- I GMRALOC'="",+$G(^DIC(42,GMRALOC,44)) S GMRALOC=$P($G(^SC(+$G(^DIC(42,GMRALOC,44)),0)),U)
- I GMRALOC="" S GMRALOC="OUT PATIENT"
- S XMB="GMRA ENTERED IN ERROR"
- ; Build XMB array
- S XMB(1)=GMRANAM ; Patient Name
- S XMB(2)=GMRASSN ; Patient SSN
- S XMB(3)=$P(GMRAPA(0),"^",2) ; Reaction
- S XMB(4)=GMRALOC ; Location
- S XMB(5)=$S($P(GMRAPA(0),U,5)'="":$$GET1^DIQ(200,$P(GMRAPA(0),U,5)_",",".01"),1:"<None>") ;21 Originator
- S XMB(6)=$$GET1^DIQ(200,$P($G(^GMR(120.8,GMRAPA,"ER")),U,3)_",",".01") ;21 Enter in error by
- S XMB(7)=$$FMTE^XLFDT($P($G(^GMR(120.8,GMRAPA,"ER")),U,2),1) ; Enter in error on
- S XMB(9)=$$FMTE^XLFDT($P(GMRAPA(0),U,4)) ;21
- ; Signs/symptoms and comments
- K ^TMP($J,"GMRACOM")
- N GMRAKIND,GMRACNT,GMRAX,GMRASP,GMRADATA,GMRAI,GMRAP ;21
- S GMRACNT=1,GMRASP=" "
- D EN1^GMRAOR2(GMRAPA,"GMRADATA") ;21
- I $D(GMRADATA("S")) S ^TMP($J,"GMRACOM",GMRACNT)=" Signs/Symptoms: " D ;21
- .S GMRAI=0,GMRAP=0 F S GMRAI=$O(GMRADATA("S",GMRAI)) Q:'+GMRAI D ;21
- ..I 'GMRAP S ^TMP($J,"GMRACOM",GMRACNT)=^TMP($J,"GMRACOM",GMRACNT)_GMRADATA("S",GMRAI),GMRACNT=GMRACNT+1,GMRAP=1 Q ;21
- ..S ^TMP($J,"GMRACOM",GMRACNT)=$$REPEAT^XLFSTR(" ",24)_GMRADATA("S",GMRAI),GMRACNT=GMRACNT+1 ;21
- 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
- F GMRAKIND="O","V","E" S GMRAX=0 S GMRAX=$O(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND,GMRAX)) I GMRAX>0 D
- .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
- .S GMRAX=0 F S GMRAX=$O(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND,GMRAX)) Q:GMRAX<1 D
- ..N GMRAY,GMRAZ
- ..S GMRAY=$P(^GMR(120.8,GMRAPA,26,GMRAX,0),U),GMRAZ=$P(^(0),U,2)
- ..D PRINT Q:GMRAOUT
- ..Q
- .Q
- S XMTEXT="^TMP($J,""GMRACOM"","
- ; Build XMY array
- ;Only send bulletin to verifier groups if reactant still needs to be verified or if it wasn't autoverified
- I '+$P(GMRAPA(0),U,16)!($P(GMRAPA(0),U,18)) F %=1:1:$L($P(GMRAPA(0),"^",20)) D ;21
- .S GMRAGRUP=$E($P(GMRAPA(0),"^",20),%)
- .S XMY("G.GMRA VERIFY "_$S(GMRAGRUP="D":"DRUG",GMRAGRUP="F":"FOOD",1:"OTHER")_" ALLERGY")=""
- .Q
- S XMY("G.GMRA MARK CHART")=""
- 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
- D ^XMB
- K XMB,XMY,XMTEXT,GMRATEXT,^TMP($J,"GMRACOM")
- Q
- PRINT ;PRINT OUT THE DATA
- N GMRAT,GMRAZN S (GMRAZN,GMRAT)=""
- S:GMRAZ'="" GMRAZN=$$GET1^DIQ(200,GMRAZ_",",".01") ;21
- S:GMRAZ'="" GMRAT=$$GET1^DIQ(200,GMRAZ_",","8","I") ;21
- S:GMRAT'="" GMRAT=$P($G(^DIC(3.1,GMRAT,0)),U)
- S ^TMP($J,"GMRACOM",GMRACNT)=$E(GMRASP,1,10)_"Date: "_$$FMTE^XLFDT(GMRAY,1)_$E(GMRASP,1,10)_"User: "_GMRAZN,GMRACNT=GMRACNT+1
- S ^TMP($J,"GMRACOM",GMRACNT)=$E(GMRASP,1,47)_"Title: "_GMRAT,GMRACNT=GMRACNT+1
- I '$D(^GMR(120.8,GMRAPA,26,GMRAX,2,0)) Q
- S DIWL=16,DIWR=75,DIWF=""
- K ^UTILITY($J,"W",DIWL)
- S GMRAXX=0 F S GMRAXX=$O(^GMR(120.8,GMRAPA,26,GMRAX,2,GMRAXX)) Q:GMRAXX<1 S X=^(GMRAXX,0) D ^DIWP
- 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
- S ^TMP($J,"GMRACOM",GMRACNT)=" ",GMRACNT=GMRACNT+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAEAB 3692 printed Feb 18, 2025@23:05:23 Page 2
- GMRAEAB ;HIRMFO/RM-BULLETIN SEND FOR E/E REACTIONS ;12/22/04 08:57
- +1 ;;4.0;Adverse Reaction Tracking;**21**;Mar 29, 1996
- EN1 ; SEND BULLETIN TO ALL VERIFIERS/CHART MARK GROUPS
- +1 ; INDICATING A/AR NEEDS UPDATES
- +2 NEW GMRAGRUP,%
- +3 SET GMRANAM=""
- SET GMRALOC=""
- SET GMRASSN=""
- +4 DO VAD^GMRAUTL1($PIECE(GMRAPA(0),U),"",.GMRALOC,.GMRANAM,"",.GMRASSN)
- +5 IF GMRALOC'=""
- IF +$GET(^DIC(42,GMRALOC,44))
- SET GMRALOC=$PIECE($GET(^SC(+$GET(^DIC(42,GMRALOC,44)),0)),U)
- +6 IF GMRALOC=""
- SET GMRALOC="OUT PATIENT"
- +7 SET XMB="GMRA ENTERED IN ERROR"
- +8 ; Build XMB array
- +9 ; Patient Name
- SET XMB(1)=GMRANAM
- +10 ; Patient SSN
- SET XMB(2)=GMRASSN
- +11 ; Reaction
- SET XMB(3)=$PIECE(GMRAPA(0),"^",2)
- +12 ; Location
- SET XMB(4)=GMRALOC
- +13 ;21 Originator
- SET XMB(5)=$SELECT($PIECE(GMRAPA(0),U,5)'="":$$GET1^DIQ(200,$PIECE(GMRAPA(0),U,5)_",",".01"),1:"<None>")
- +14 ;21 Enter in error by
- SET XMB(6)=$$GET1^DIQ(200,$PIECE($GET(^GMR(120.8,GMRAPA,"ER")),U,3)_",",".01")
- +15 ; Enter in error on
- SET XMB(7)=$$FMTE^XLFDT($PIECE($GET(^GMR(120.8,GMRAPA,"ER")),U,2),1)
- +16 ;21
- SET XMB(9)=$$FMTE^XLFDT($PIECE(GMRAPA(0),U,4))
- +17 ; Signs/symptoms and comments
- +18 KILL ^TMP($JOB,"GMRACOM")
- +19 ;21
- NEW GMRAKIND,GMRACNT,GMRAX,GMRASP,GMRADATA,GMRAI,GMRAP
- +20 SET GMRACNT=1
- SET GMRASP=" "
- +21 ;21
- DO EN1^GMRAOR2(GMRAPA,"GMRADATA")
- +22 ;21
- IF $DATA(GMRADATA("S"))
- SET ^TMP($JOB,"GMRACOM",GMRACNT)=" Signs/Symptoms: "
- Begin DoDot:1
- +23 ;21
- SET GMRAI=0
- SET GMRAP=0
- FOR
- SET GMRAI=$ORDER(GMRADATA("S",GMRAI))
- if '+GMRAI
- QUIT
- Begin DoDot:2
- +24 ;21
- IF 'GMRAP
- SET ^TMP($JOB,"GMRACOM",GMRACNT)=^TMP($JOB,"GMRACOM",GMRACNT)_GMRADATA("S",GMRAI)
- SET GMRACNT=GMRACNT+1
- SET GMRAP=1
- QUIT
- +25 ;21
- SET ^TMP($JOB,"GMRACOM",GMRACNT)=$$REPEAT^XLFSTR(" ",24)_GMRADATA("S",GMRAI)
- SET GMRACNT=GMRACNT+1
- End DoDot:2
- End DoDot:1
- +26 ;21
- IF $DATA(^GMR(120.8,GMRAPA,26,"AVER"))
- SET ^TMP($JOB,"GMRACOM",GMRACNT)=""
- SET GMRACNT=GMRACNT+1
- SET ^TMP($JOB,"GMRACOM",GMRACNT)="Comments:"
- SET GMRACNT=GMRACNT+1
- +27 FOR GMRAKIND="O","V","E"
- SET GMRAX=0
- SET GMRAX=$ORDER(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND,GMRAX))
- IF GMRAX>0
- Begin DoDot:1
- +28 SET ^TMP($JOB,"GMRACOM",GMRACNT)=$EXTRACT(GMRASP,1,5)_$SELECT(GMRAKIND="O":"ORIGINATOR",GMRAKIND="V":"VERIFIER",GMRAKIND="E":"ENTERED IN ERROR",1:"")
- SET GMRACNT=GMRACNT+1
- +29 SET GMRAX=0
- FOR
- SET GMRAX=$ORDER(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND,GMRAX))
- if GMRAX<1
- QUIT
- Begin DoDot:2
- +30 NEW GMRAY,GMRAZ
- +31 SET GMRAY=$PIECE(^GMR(120.8,GMRAPA,26,GMRAX,0),U)
- SET GMRAZ=$PIECE(^(0),U,2)
- +32 DO PRINT
- if GMRAOUT
- QUIT
- +33 QUIT
- End DoDot:2
- +34 QUIT
- End DoDot:1
- +35 SET XMTEXT="^TMP($J,""GMRACOM"","
- +36 ; Build XMY array
- +37 ;Only send bulletin to verifier groups if reactant still needs to be verified or if it wasn't autoverified
- +38 ;21
- IF '+$PIECE(GMRAPA(0),U,16)!($PIECE(GMRAPA(0),U,18))
- FOR %=1:1:$LENGTH($PIECE(GMRAPA(0),"^",20))
- Begin DoDot:1
- +39 SET GMRAGRUP=$EXTRACT($PIECE(GMRAPA(0),"^",20),%)
- +40 SET XMY("G.GMRA VERIFY "_$SELECT(GMRAGRUP="D":"DRUG",GMRAGRUP="F":"FOOD",1:"OTHER")_" ALLERGY")=""
- +41 QUIT
- End DoDot:1
- +42 SET XMY("G.GMRA MARK CHART")=""
- +43 ;21
- IF $PIECE(GMRAPA(0),U,20)["D"&($PIECE(GMRAPA(0),U,6)="o")
- SET XMY("G.GMRA P&T COMMITTEE FDA")=""
- SET XMB(8)="and FDA information "
- +44 DO ^XMB
- +45 KILL XMB,XMY,XMTEXT,GMRATEXT,^TMP($JOB,"GMRACOM")
- +46 QUIT
- PRINT ;PRINT OUT THE DATA
- +1 NEW GMRAT,GMRAZN
- SET (GMRAZN,GMRAT)=""
- +2 ;21
- if GMRAZ'=""
- SET GMRAZN=$$GET1^DIQ(200,GMRAZ_",",".01")
- +3 ;21
- if GMRAZ'=""
- SET GMRAT=$$GET1^DIQ(200,GMRAZ_",","8","I")
- +4 if GMRAT'=""
- SET GMRAT=$PIECE($GET(^DIC(3.1,GMRAT,0)),U)
- +5 SET ^TMP($JOB,"GMRACOM",GMRACNT)=$EXTRACT(GMRASP,1,10)_"Date: "_$$FMTE^XLFDT(GMRAY,1)_$EXTRACT(GMRASP,1,10)_"User: "_GMRAZN
- SET GMRACNT=GMRACNT+1
- +6 SET ^TMP($JOB,"GMRACOM",GMRACNT)=$EXTRACT(GMRASP,1,47)_"Title: "_GMRAT
- SET GMRACNT=GMRACNT+1
- +7 IF '$DATA(^GMR(120.8,GMRAPA,26,GMRAX,2,0))
- QUIT
- +8 SET DIWL=16
- SET DIWR=75
- SET DIWF=""
- +9 KILL ^UTILITY($JOB,"W",DIWL)
- +10 SET GMRAXX=0
- FOR
- SET GMRAXX=$ORDER(^GMR(120.8,GMRAPA,26,GMRAX,2,GMRAXX))
- if GMRAXX<1
- QUIT
- SET X=^(GMRAXX,0)
- DO ^DIWP
- +11 SET GMRAXX=0
- FOR
- SET GMRAXX=$ORDER(^UTILITY($JOB,"W",DIWL,GMRAXX))
- if GMRAXX<1
- QUIT
- SET ^TMP($JOB,"GMRACOM",GMRACNT)=$EXTRACT(GMRASP,1,16)_^UTILITY($JOB,"W",DIWL,GMRAXX,0)
- SET GMRACNT=GMRACNT+1
- +12 SET ^TMP($JOB,"GMRACOM",GMRACNT)=" "
- SET GMRACNT=GMRACNT+1
- +13 QUIT