GMRAVAB ;HIRMFO/RM-BULLETIN SENT TO VERIFY A/AR ; 12/18/90 [ 05/06/2002 4:25 PM ]
;;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)
;IHS/ITSC/ENM 05/06/02
S DFN=$P(GMRAPA(0),U),APSPHRN=$$HRCN^APSGFUNC
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)
;IHS/ITSC/ENM 05/06/02
S XMB(3)=$S(GMRALOC'="":GMRALOC,1:"Outpatient"),XMB(4)=APSPHRN
;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,APSPHRN ;IHS/ITSC/ENM 05/06/02
Q
GMRAVAB ;HIRMFO/RM-BULLETIN SENT TO VERIFY A/AR ; 12/18/90 [ 05/06/2002 4:25 PM ]
+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 ;IHS/ITSC/ENM 05/06/02
+7 SET DFN=$PIECE(GMRAPA(0),U)
SET APSPHRN=$$HRCN^APSGFUNC
+8 IF GMRALOC'=""
IF +$GET(^DIC(42,GMRALOC,44))
SET GMRALOC=$PIECE($GET(^SC(+$GET(^DIC(42,GMRALOC,44)),0)),U)
+9 IF GMRALOC=""
SET GMRALOC="OUT PATIENT"
+10 SET XMB="GMRA VERIFY ALLERGY"
+11 SET XMB(1)=GMRANAM
+12 SET XMB(2)=$PIECE(GMRAPA(0),"^",2)
+13 ;IHS/ITSC/ENM 05/06/02
+14 SET XMB(3)=$SELECT(GMRALOC'="":GMRALOC,1:"Outpatient")
SET XMB(4)=APSPHRN
+15 ;S XMB(3)=$S(GMRALOC'="":GMRALOC,1:"Outpatient"),XMB(4)=GMRASSN
+16 SET XMB(5)=$SELECT($PIECE(GMRAPA(0),U,6)="o":"Observed",$PIECE(GMRAPA(0),U,6)="h":"Historical",1:"")
+17 ; Build XMT array
+18 FOR %=1:1:$LENGTH($PIECE(GMRAPA(0),"^",20))
Begin DoDot:1
+19 SET GMRAGRUP=$EXTRACT($PIECE(GMRAPA(0),"^",20),%)
+20 SET XMY("G.GMRA VERIFY "_$SELECT(GMRAGRUP="D":"DRUG",GMRAGRUP="F":"FOOD",1:"OTHER")_" ALLERGY")=""
+21 QUIT
End DoDot:1
+22 KILL GMRAREC
IF $DATA(^GMR(120.8,GMRAPA,10,0))
Begin DoDot:1
+23 SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
+24 SET GMRAREC=0
FOR
SET GMRAREC=$ORDER(^GMR(120.8,GMRAPA,10,GMRAREC))
IF GMRAREC'>0
QUIT
Begin DoDot:2
+25 SET X=$GET(^GMR(120.8,GMRAPA,10,GMRAREC,0))
+26 SET GMRAREC(GMRAREC)=$SELECT($PIECE(X,U)'=GMRAOTH:$PIECE($GET(^GMRD(120.83,+$PIECE(X,U),0)),"^"),1:$PIECE(X,U,2))
+27 IF +$PIECE(X,U,4)>0
Begin DoDot:3
+28 NEW GMRASP,GMRAI
SET GMRASP=" "
+29 SET GMRAREC(GMRAREC)=$EXTRACT(GMRAREC(GMRAREC),1,40)
+30 FOR GMRAI=$LENGTH(GMRAREC(GMRAREC)):1:40
SET GMRAREC(GMRAREC)=GMRAREC(GMRAREC)_GMRASP
+31 SET GMRAREC(GMRAREC)=GMRAREC(GMRAREC)_" "_$$FMTE^XLFDT($PIECE(X,U,4),1)
+32 QUIT
End DoDot:3
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 KILL GMRATXT
+36 IF $DATA(GMRAREC)=11
SET GMRACNT=3
SET GMRAREC=0
Begin DoDot:1
+37 SET GMRATXT(1)="Signs/Symptoms Date Observed"
+38 SET GMRATXT(2)=$$REPEAT^XLFSTR("-",60)
+39 FOR
SET GMRAREC=$ORDER(GMRAREC(GMRAREC))
IF GMRAREC<1
QUIT
SET GMRATXT(GMRACNT)=GMRAREC(GMRAREC)
SET GMRACNT=GMRACNT+1
+40 QUIT
End DoDot:1
+41 IF $DATA(GMRATXT)
SET XMTEXT="GMRATXT("
+42 DO ^XMB
+43 ;IHS/ITSC/ENM 05/06/02
KILL XMB,XMY,GMRACNT,GMRAREC,GMRATXT,XMTEXT,APSPHRN
+44 QUIT
