- GMRARAD0 ;HIRMFO/RM-Radiology\ART Interface Routine (cont.);12/30/93
- ;;4.0;Adverse Reaction Tracking;**41**;Mar 29, 1996;Build 8
- NKADD ; This entry point will add the NKA entry in file 120.8 if needed.
- N GMRATMP,GMRAPA,GMRA,GMRAY,GMRAX,DA,DFN,DIK
- S GMRA(0)=GMRAL
- Q:$P($G(^GMR(120.86,+GMRA(0),0)),U,2)=1
- I '$D(^GMR(120.86,+GMRA(0),0)) D
- .N GMRACNT,GMRADFN,GMRAX
- .S GMRADFN=+GMRA(0),GMRAX=$G(^GMR(120.86,0))
- .S:GMRAX="" GMRAX="ADVERSE REACTION ASSESSMENT^120.86P^^"
- .S GMRACNT=($P(GMRAX,U,4)+1),^GMR(120.86,GMRADFN,0)=GMRADFN_U_"1"
- .S ^GMR(120.86,"B",GMRADFN,GMRADFN)=""
- .S $P(GMRAX,U,3,4)=GMRADFN_U_GMRACNT S ^GMR(120.86,0)=GMRAX
- .Q
- I $P($G(^GMR(120.86,+GMRA(0),0)),U,2)'=1 S $P(^(0),U,2)="1"
- Q
- CHKEXAL ; This entry point will check the database for existing Rad. Allergies,
- ; and ask user if they should be entered in error.
- S GMRADA=0 F S GMRADA=$O(^GMR(120.8,"B",DFN,GMRADA)) Q:GMRADA'>0 I $$RALLG^GMRARAD(GMRADA) Q
- Q:GMRADA'>0 W $C(7),!!!,$C(7)
- S DIR("A",1)="*** WARNING *** WARNING *** WARNING ***",DIR("A",2)="Contrast media allergies have already been documented for this patient.",DIR("A",3)="By answering this question NO, you will be deleting this data."
- S DIR("A")="ARE YOU SURE THIS IS WHAT YOU WANT TO DO? ",DIR("?")="Answer Yes if you want to delete existing data, else answer No.",DIR(0)="YA" D ^DIR
- I Y'=1 S FXN=1 Q
- S GMRADA=0 F S GMRADA=$O(^GMR(120.8,"B",DFN,GMRADA)) Q:GMRADA'>0 I $$RALLG^GMRARAD(GMRADA) D
- . S GMRAER=$G(^GMR(120.8,GMRADA,"ER")),DA=GMRADA
- . F GMRAX=22,23,24 S X=$S(GMRAX=22:$P(GMRAER,U),GMRAX=23:$P(GMRAER,U,2),1:$P(GMRAER,U,3)),GMRAY=0 F S GMRAY=$O(^DD(120.8,GMRAX,1,GMRAY)) Q:GMRAY'>0 X:$D(^DD(120.8,GMRAX,1,GMRAY,2)) ^(2)
- . S GMRAER="1^"_$$HTFM^XLFDT($H)_"^"_DUZ,^GMR(120.8,GMRADA,"ER")=GMRAER
- . F GMRAX=22,23,24 S X=$S(GMRAX=22:$P(GMRAER,U),GMRAX=23:$P(GMRAER,U,2),1:$P(GMRAER,U,3)),GMRAY=0 F S GMRAY=$O(^DD(120.8,GMRAX,1,GMRAY)) Q:GMRAY'>0 X:$D(^DD(120.8,GMRAX,1,GMRAY,1)) ^(1)
- Q
- QBULL ; THIS ENTRY POINT WILL ALLOW BE CALLED AS A TASKED JOB TO SEND
- ; BULLETINS FOR A RAD ALLERGY IF NECESSARY.
- ; INPUT VARIABLE: GMRAPA = IEN 120.8 ENTRY
- Q:GMRAPA'>0
- S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:$P(GMRAPA(0),U,2)=""
- S DFN=+GMRAPA(0) Q:DFN'>0
- D 1^VADPT S GMRANAM=VADM(1),GMRALOC=$P(VAIN(4),U,2),GMRAVIP=VA("PID") D KVAR^VADPT K VA
- D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0))
- I '$P(GMRAPA(0),U,16) D EN1^GMRAVAB ; Send Verify bull. if not ver.
- I '$O(^GMR(120.8,GMRAPA,13,0))!'($P(GMRASITE(0),U,5)=0!(GMRALOC="")!$O(^GMR(120.8,GMRAPA,14,0))) D BULLT^GMRASEND ; Send Mark Chart/ID Band bull. if necessary.
- I $P(GMRAPA(0),U,6)="o",$P(GMRAPA(0),U,20)["D" D PTBUL^GMRAROBS ; Send P&T bull. if observed drug rxn.
- K %,DFN,GMRAHLOC,GMRALOC,GMRANAM,GMRAOUT,GMRAPA,GMRASITE,GMRATYPE,GMRAVIP,XMB,XMY,XQA,XQAMSG S ZTREQ="@"
- Q
- DRCLRACK(DA) ; This function will determine if entry DA in 120.8 represents
- ; a contrast media allergy that is not entered in error if the Drug
- ; Class DX100 is deleted.
- ; Input variable: DA=entry in file 120.8
- ; Return value: 1 if entry is contrast media allergy, 0 if not
- ;
- N FXN,ZERO,DRCL,DRCL1,DRCL2
- S FXN=0,ZERO=$G(^GMR(120.8,DA(1),0))
- I '+$G(^GMR(120.8,DA(1),"ER")) D
- . F DRCL="DX100","DX101","DX102" D Q:FXN
- . . ;41-VS
- . . D IEN^PSN50P65("",DRCL,"ENCAP")
- . . S DRCL1=$O(^TMP($J,"ENCAP","B",DRCL,0))_";PS(50.605,"
- . . K ^TMP($J,"ENCAP")
- . . ;41-VS
- . . I $P(ZERO,U,3)=DRCL1 S FXN=1 Q
- . . S DRCL2=0 F S DRCL2=$O(^GMR(120.8,DA(1),3,DRCL2)) Q:DRCL2<1 I DRCL2'=DA,+$G(^GMR(120.8,DA(1),3,DRCL2,0))=+DRCL1 S FXN=1 Q
- . . Q
- . I 'FXN,$P(ZERO,U,3)["GMRD(120.82"&$D(^GMRD(120.82,"D","RADIOLOGICAL/CONTRAST MEDIA",+$P(ZERO,U,3))) S FXN=1
- . Q
- Q FXN
- GMRARAD0 ;HIRMFO/RM-Radiology\ART Interface Routine (cont.);12/30/93
- +1 ;;4.0;Adverse Reaction Tracking;**41**;Mar 29, 1996;Build 8
- NKADD ; This entry point will add the NKA entry in file 120.8 if needed.
- +1 NEW GMRATMP,GMRAPA,GMRA,GMRAY,GMRAX,DA,DFN,DIK
- +2 SET GMRA(0)=GMRAL
- +3 IF $PIECE($GET(^GMR(120.86,+GMRA(0),0)),U,2)=1
- QUIT
- +4 IF '$DATA(^GMR(120.86,+GMRA(0),0))
- Begin DoDot:1
- +5 NEW GMRACNT,GMRADFN,GMRAX
- +6 SET GMRADFN=+GMRA(0)
- SET GMRAX=$GET(^GMR(120.86,0))
- +7 IF GMRAX=""
- SET GMRAX="ADVERSE REACTION ASSESSMENT^120.86P^^"
- +8 SET GMRACNT=($PIECE(GMRAX,U,4)+1)
- SET ^GMR(120.86,GMRADFN,0)=GMRADFN_U_"1"
- +9 SET ^GMR(120.86,"B",GMRADFN,GMRADFN)=""
- +10 SET $PIECE(GMRAX,U,3,4)=GMRADFN_U_GMRACNT
- SET ^GMR(120.86,0)=GMRAX
- +11 QUIT
- End DoDot:1
- +12 IF $PIECE($GET(^GMR(120.86,+GMRA(0),0)),U,2)'=1
- SET $PIECE(^(0),U,2)="1"
- +13 QUIT
- CHKEXAL ; This entry point will check the database for existing Rad. Allergies,
- +1 ; and ask user if they should be entered in error.
- +2 SET GMRADA=0
- FOR
- SET GMRADA=$ORDER(^GMR(120.8,"B",DFN,GMRADA))
- IF GMRADA'>0
- QUIT
- IF $$RALLG^GMRARAD(GMRADA)
- QUIT
- +3 IF GMRADA'>0
- QUIT
- WRITE $CHAR(7),!!!,$CHAR(7)
- +4 SET DIR("A",1)="*** WARNING *** WARNING *** WARNING ***"
- SET DIR("A",2)="Contrast media allergies have already been documented for this patient."
- SET DIR("A",3)="By answering this question NO, you will be deleting this data."
- +5 SET DIR("A")="ARE YOU SURE THIS IS WHAT YOU WANT TO DO? "
- SET DIR("?")="Answer Yes if you want to delete existing data, else answer No."
- SET DIR(0)="YA"
- DO ^DIR
- +6 IF Y'=1
- SET FXN=1
- QUIT
- +7 SET GMRADA=0
- FOR
- SET GMRADA=$ORDER(^GMR(120.8,"B",DFN,GMRADA))
- IF GMRADA'>0
- QUIT
- IF $$RALLG^GMRARAD(GMRADA)
- Begin DoDot:1
- +8 SET GMRAER=$GET(^GMR(120.8,GMRADA,"ER"))
- SET DA=GMRADA
- +9 FOR GMRAX=22,23,24
- SET X=$SELECT(GMRAX=22:$PIECE(GMRAER,U),GMRAX=23:$PIECE(GMRAER,U,2),1:$PIECE(GMRAER,U,3))
- SET GMRAY=0
- FOR
- SET GMRAY=$ORDER(^DD(120.8,GMRAX,1,GMRAY))
- IF GMRAY'>0
- QUIT
- IF $DATA(^DD(120.8,GMRAX,1,GMRAY,2))
- XECUTE ^(2)
- +10 SET GMRAER="1^"_$$HTFM^XLFDT($HOROLOG)_"^"_DUZ
- SET ^GMR(120.8,GMRADA,"ER")=GMRAER
- +11 FOR GMRAX=22,23,24
- SET X=$SELECT(GMRAX=22:$PIECE(GMRAER,U),GMRAX=23:$PIECE(GMRAER,U,2),1:$PIECE(GMRAER,U,3))
- SET GMRAY=0
- FOR
- SET GMRAY=$ORDER(^DD(120.8,GMRAX,1,GMRAY))
- IF GMRAY'>0
- QUIT
- IF $DATA(^DD(120.8,GMRAX,1,GMRAY,1))
- XECUTE ^(1)
- End DoDot:1
- +12 QUIT
- QBULL ; THIS ENTRY POINT WILL ALLOW BE CALLED AS A TASKED JOB TO SEND
- +1 ; BULLETINS FOR A RAD ALLERGY IF NECESSARY.
- +2 ; INPUT VARIABLE: GMRAPA = IEN 120.8 ENTRY
- +3 IF GMRAPA'>0
- QUIT
- +4 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
- IF $PIECE(GMRAPA(0),U,2)=""
- QUIT
- +5 SET DFN=+GMRAPA(0)
- IF DFN'>0
- QUIT
- +6 DO 1^VADPT
- SET GMRANAM=VADM(1)
- SET GMRALOC=$PIECE(VAIN(4),U,2)
- SET GMRAVIP=VA("PID")
- DO KVAR^VADPT
- KILL VA
- +7 DO SITE^GMRAUTL
- SET GMRASITE(0)=$GET(^GMRD(120.84,+GMRASITE,0))
- +8 ; Send Verify bull. if not ver.
- IF '$PIECE(GMRAPA(0),U,16)
- DO EN1^GMRAVAB
- +9 ; Send Mark Chart/ID Band bull. if necessary.
- IF '$ORDER(^GMR(120.8,GMRAPA,13,0))!'($PIECE(GMRASITE(0),U,5)=0!(GMRALOC="")!$ORDER(^GMR(120.8,GMRAPA,14,0)))
- DO BULLT^GMRASEND
- +10 ; Send P&T bull. if observed drug rxn.
- IF $PIECE(GMRAPA(0),U,6)="o"
- IF $PIECE(GMRAPA(0),U,20)["D"
- DO PTBUL^GMRAROBS
- +11 KILL %,DFN,GMRAHLOC,GMRALOC,GMRANAM,GMRAOUT,GMRAPA,GMRASITE,GMRATYPE,GMRAVIP,XMB,XMY,XQA,XQAMSG
- SET ZTREQ="@"
- +12 QUIT
- DRCLRACK(DA) ; This function will determine if entry DA in 120.8 represents
- +1 ; a contrast media allergy that is not entered in error if the Drug
- +2 ; Class DX100 is deleted.
- +3 ; Input variable: DA=entry in file 120.8
- +4 ; Return value: 1 if entry is contrast media allergy, 0 if not
- +5 ;
- +6 NEW FXN,ZERO,DRCL,DRCL1,DRCL2
- +7 SET FXN=0
- SET ZERO=$GET(^GMR(120.8,DA(1),0))
- +8 IF '+$GET(^GMR(120.8,DA(1),"ER"))
- Begin DoDot:1
- +9 FOR DRCL="DX100","DX101","DX102"
- Begin DoDot:2
- +10 ;41-VS
- +11 DO IEN^PSN50P65("",DRCL,"ENCAP")
- +12 SET DRCL1=$ORDER(^TMP($JOB,"ENCAP","B",DRCL,0))_";PS(50.605,"
- +13 KILL ^TMP($JOB,"ENCAP")
- +14 ;41-VS
- +15 IF $PIECE(ZERO,U,3)=DRCL1
- SET FXN=1
- QUIT
- +16 SET DRCL2=0
- FOR
- SET DRCL2=$ORDER(^GMR(120.8,DA(1),3,DRCL2))
- IF DRCL2<1
- QUIT
- IF DRCL2'=DA
- IF +$GET(^GMR(120.8,DA(1),3,DRCL2,0))=+DRCL1
- SET FXN=1
- QUIT
- +17 QUIT
- End DoDot:2
- IF FXN
- QUIT
- +18 IF 'FXN
- IF $PIECE(ZERO,U,3)["GMRD(120.82"&$DATA(^GMRD(120.82,"D","RADIOLOGICAL/CONTRAST MEDIA",+$PIECE(ZERO,U,3)))
- SET FXN=1
- +19 QUIT
- End DoDot:1
- +20 QUIT FXN
