GMRACMR5 ;HIRMFO/WAA-PATIENT NOT ASKED ABOUT ALLERGIES ; 10/1/92
;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
IDMARK(DFN,GMRADATE,GMRAIEN) ;
; Find if an IDBAND has been mark for a date range
; Input Variable List
; GMRADATE = The date of the event
; DFN = Patient DFN
; GMRAIEN = IEN for reaction to check
;
; Extrinsic Function Variable List
; GMRAID = Return value of extrinsic function
; 1 means ID Band was marked for this admission.
; 0 means ID Band was not marked.
; GMRADM = Admission Date
; GMRAD = Patient Movement IEN for discharge
; GMRADIS = Discharge Date
; GMRAX = Scratch Variable
; VAINDT = Admission date (used for ADM^VADPT2 call)
; VADMVT = Patient Movement IEN for admission
;
N GMRADM,GMRADIS,GMRAD,GMRAID,GMRAX,VAINDT,VADMVT
S GMRAID=0
S:GMRADATE'="CURRENT" VAINDT=GMRADATE D ADM^VADPT2
S GMRADM=$P($G(^DGPM(VADMVT,0)),U) ; ADM MOVEMENT DATE
S GMRAD=$P($G(^DGPM(VADMVT,0)),U,17) ; GET DISCHARGE IEN
S GMRADIS=$P($G(^DGPM(+GMRAD,0)),U) ; GET DISCHARGE DATE
I GMRADIS="" S GMRADIS=$$NOW^XLFDT ; IF NO DISCHARGE DATE SET TO TODAY
S GMRAX=$O(^GMR(120.8,GMRAIEN,14,"B",GMRADM)) ; GRAB THE DATE FROM ART
I GMRAX'="",GMRAX<GMRADIS S GMRAID=1 ;VERIFY IT IS BETWEEN THE DATES
Q GMRAID
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRACMR5 1342 printed Oct 16, 2024@17:39:39 Page 2
GMRACMR5 ;HIRMFO/WAA-PATIENT NOT ASKED ABOUT ALLERGIES ; 10/1/92
+1 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
IDMARK(DFN,GMRADATE,GMRAIEN) ;
+1 ; Find if an IDBAND has been mark for a date range
+2 ; Input Variable List
+3 ; GMRADATE = The date of the event
+4 ; DFN = Patient DFN
+5 ; GMRAIEN = IEN for reaction to check
+6 ;
+7 ; Extrinsic Function Variable List
+8 ; GMRAID = Return value of extrinsic function
+9 ; 1 means ID Band was marked for this admission.
+10 ; 0 means ID Band was not marked.
+11 ; GMRADM = Admission Date
+12 ; GMRAD = Patient Movement IEN for discharge
+13 ; GMRADIS = Discharge Date
+14 ; GMRAX = Scratch Variable
+15 ; VAINDT = Admission date (used for ADM^VADPT2 call)
+16 ; VADMVT = Patient Movement IEN for admission
+17 ;
+18 NEW GMRADM,GMRADIS,GMRAD,GMRAID,GMRAX,VAINDT,VADMVT
+19 SET GMRAID=0
+20 if GMRADATE'="CURRENT"
SET VAINDT=GMRADATE
DO ADM^VADPT2
+21 ; ADM MOVEMENT DATE
SET GMRADM=$PIECE($GET(^DGPM(VADMVT,0)),U)
+22 ; GET DISCHARGE IEN
SET GMRAD=$PIECE($GET(^DGPM(VADMVT,0)),U,17)
+23 ; GET DISCHARGE DATE
SET GMRADIS=$PIECE($GET(^DGPM(+GMRAD,0)),U)
+24 ; IF NO DISCHARGE DATE SET TO TODAY
IF GMRADIS=""
SET GMRADIS=$$NOW^XLFDT
+25 ; GRAB THE DATE FROM ART
SET GMRAX=$ORDER(^GMR(120.8,GMRAIEN,14,"B",GMRADM))
+26 ;VERIFY IT IS BETWEEN THE DATES
IF GMRAX'=""
IF GMRAX<GMRADIS
SET GMRAID=1
+27 QUIT GMRAID
