- 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
