GMRAVAB ;HIRMFO/RM-BULLETIN SENT TO VERIFY A/AR ; 12/18/90
;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
EN1 ; SEND BULLETIN TO ALL VERIFIERS INDICATING A/AR NEEDS VERIFICATION
D KILL^XM
N GMRAGRUP,%
S GMRANAM="",GMRALOC="",GMRASSN=""
; Build XMB array
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 VERIFY ALLERGY"
S XMB(1)=GMRANAM
S XMB(2)=$P(GMRAPA(0),"^",2)
S XMB(3)=$S(GMRALOC'="":GMRALOC,1:"Outpatient"),XMB(4)=GMRASSN
S XMB(5)=$S($P(GMRAPA(0),U,6)="o":"Observed",$P(GMRAPA(0),U,6)="h":"Historical",1:"")
; Build XMT array
F %=1:1:$L($P(GMRAPA(0),"^",20)) D
.S GMRAGRUP=$E($P(GMRAPA(0),"^",20),%)
.S XMY("G.GMRA VERIFY "_$S(GMRAGRUP="D":"DRUG",GMRAGRUP="F":"FOOD",1:"OTHER")_" ALLERGY")=""
.Q
K GMRAREC I $D(^GMR(120.8,GMRAPA,10,0)) D
.S GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
.S GMRAREC=0 F S GMRAREC=$O(^GMR(120.8,GMRAPA,10,GMRAREC)) Q:GMRAREC'>0 D
..S X=$G(^GMR(120.8,GMRAPA,10,GMRAREC,0))
..S GMRAREC(GMRAREC)=$S($P(X,U)'=GMRAOTH:$P($G(^GMRD(120.83,+$P(X,U),0)),"^"),1:$P(X,U,2))
..I +$P(X,U,4)>0 D
...N GMRASP,GMRAI S GMRASP=" "
...S GMRAREC(GMRAREC)=$E(GMRAREC(GMRAREC),1,40)
...F GMRAI=$L(GMRAREC(GMRAREC)):1:40 S GMRAREC(GMRAREC)=GMRAREC(GMRAREC)_GMRASP
...S GMRAREC(GMRAREC)=GMRAREC(GMRAREC)_" "_$$FMTE^XLFDT($P(X,U,4),1)
...Q
..Q
.Q
K GMRATXT
I $D(GMRAREC)=11 S GMRACNT=3,GMRAREC=0 D
.S GMRATXT(1)="Signs/Symptoms Date Observed"
.S GMRATXT(2)=$$REPEAT^XLFSTR("-",60)
.F S GMRAREC=$O(GMRAREC(GMRAREC)) Q:GMRAREC<1 S GMRATXT(GMRACNT)=GMRAREC(GMRAREC),GMRACNT=GMRACNT+1
.Q
I $D(GMRATXT) S XMTEXT="GMRATXT("
D ^XMB
K XMB,XMY,GMRACNT,GMRAREC,GMRATXT,XMTEXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAVAB 1853 printed Dec 13, 2024@01:40:42 Page 2
GMRAVAB ;HIRMFO/RM-BULLETIN SENT TO VERIFY A/AR ; 12/18/90
+1 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
EN1 ; SEND BULLETIN TO ALL VERIFIERS INDICATING A/AR NEEDS VERIFICATION
+1 DO KILL^XM
+2 NEW GMRAGRUP,%
+3 SET GMRANAM=""
SET GMRALOC=""
SET GMRASSN=""
+4 ; Build XMB array
+5 DO VAD^GMRAUTL1($PIECE(GMRAPA(0),U),"",.GMRALOC,.GMRANAM,"",.GMRASSN)
+6 IF GMRALOC'=""
IF +$GET(^DIC(42,GMRALOC,44))
SET GMRALOC=$PIECE($GET(^SC(+$GET(^DIC(42,GMRALOC,44)),0)),U)
+7 IF GMRALOC=""
SET GMRALOC="OUT PATIENT"
+8 SET XMB="GMRA VERIFY ALLERGY"
+9 SET XMB(1)=GMRANAM
+10 SET XMB(2)=$PIECE(GMRAPA(0),"^",2)
+11 SET XMB(3)=$SELECT(GMRALOC'="":GMRALOC,1:"Outpatient")
SET XMB(4)=GMRASSN
+12 SET XMB(5)=$SELECT($PIECE(GMRAPA(0),U,6)="o":"Observed",$PIECE(GMRAPA(0),U,6)="h":"Historical",1:"")
+13 ; Build XMT array
+14 FOR %=1:1:$LENGTH($PIECE(GMRAPA(0),"^",20))
Begin DoDot:1
+15 SET GMRAGRUP=$EXTRACT($PIECE(GMRAPA(0),"^",20),%)
+16 SET XMY("G.GMRA VERIFY "_$SELECT(GMRAGRUP="D":"DRUG",GMRAGRUP="F":"FOOD",1:"OTHER")_" ALLERGY")=""
+17 QUIT
End DoDot:1
+18 KILL GMRAREC
IF $DATA(^GMR(120.8,GMRAPA,10,0))
Begin DoDot:1
+19 SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
+20 SET GMRAREC=0
FOR
SET GMRAREC=$ORDER(^GMR(120.8,GMRAPA,10,GMRAREC))
if GMRAREC'>0
QUIT
Begin DoDot:2
+21 SET X=$GET(^GMR(120.8,GMRAPA,10,GMRAREC,0))
+22 SET GMRAREC(GMRAREC)=$SELECT($PIECE(X,U)'=GMRAOTH:$PIECE($GET(^GMRD(120.83,+$PIECE(X,U),0)),"^"),1:$PIECE(X,U,2))
+23 IF +$PIECE(X,U,4)>0
Begin DoDot:3
+24 NEW GMRASP,GMRAI
SET GMRASP=" "
+25 SET GMRAREC(GMRAREC)=$EXTRACT(GMRAREC(GMRAREC),1,40)
+26 FOR GMRAI=$LENGTH(GMRAREC(GMRAREC)):1:40
SET GMRAREC(GMRAREC)=GMRAREC(GMRAREC)_GMRASP
+27 SET GMRAREC(GMRAREC)=GMRAREC(GMRAREC)_" "_$$FMTE^XLFDT($PIECE(X,U,4),1)
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 KILL GMRATXT
+32 IF $DATA(GMRAREC)=11
SET GMRACNT=3
SET GMRAREC=0
Begin DoDot:1
+33 SET GMRATXT(1)="Signs/Symptoms Date Observed"
+34 SET GMRATXT(2)=$$REPEAT^XLFSTR("-",60)
+35 FOR
SET GMRAREC=$ORDER(GMRAREC(GMRAREC))
if GMRAREC<1
QUIT
SET GMRATXT(GMRACNT)=GMRAREC(GMRAREC)
SET GMRACNT=GMRACNT+1
+36 QUIT
End DoDot:1
+37 IF $DATA(GMRATXT)
SET XMTEXT="GMRATXT("
+38 DO ^XMB
+39 KILL XMB,XMY,GMRACNT,GMRAREC,GMRATXT,XMTEXT
+40 QUIT
