- GMRAEF1 ;HIRMFO/WAA-FDA EXCEPTION REPORT ; 11/25/92
- ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
- EN1 ; Entry to PRINT PATIENT FDA EXCEPTION DATA option
- K DIC S GMRAOUT=0
- W ! S DIC="^DPT(",DIC(0)="AEQM"
- D ^DIC K DIC,DLAYGO G:+Y'>0 EN1Q
- S GMRDFN=+Y D EN2 G:'GMRAOUT EN1
- EN1Q K GMRDFN,DIC,GMRAOUT
- D KILL^XUSCLEAN G EXIT
- EN2 ;
- S GMRAX=$P($G(^GMR(120.86,GMRDFN,0)),U,2) I GMRAX=0 W !,"This patient has No Known Allergies" K GMRAX Q
- S X=0 F X=0:0 S X=$O(^GMR(120.8,"B",GMRDFN,X)) Q:X'>0 I '+$G(^GMR(120.8,X,"ER")) S X=X+1 Q
- I 'X W !,"This patient has no allergies on file" Q
- DDATE ;Select discharge date
- K DIR S DIR("A")="Enter the Date to start search (Time optional)"
- S DIR("B")="T-30",DIR(0)="DO^::AET"
- S DIR("?")="ENTER THE DATE YOU WANT THE SYSTEM TO START IT'S SEARCH"
- D ^DIR K DIR
- I "^^"[Y S GMRAOUT=1 G EXIT
- I $D(DIRUT) G EXIT
- S GMRASTDT=Y
- S GMRAIEN=0 F S GMRAIEN=$O(^GMR(120.8,"B",GMRDFN,GMRAIEN)) Q:GMRAIEN<1 D
- .Q:+$G(^GMR(120.8,GMRAIEN,"ER"))
- .S GMRA(0)=$G(^GMR(120.8,GMRAIEN,0))
- .Q:GMRA(0)=""
- .I $P(GMRA(0),U,6)'="o"!($P(GMRA(0),U,20)'["D") Q
- .I '$P(GMRA(0),U,12) Q
- .I $P(GMRA(0),U,4)<GMRASTDT Q
- .I $$CMPFDA(GMRAIEN) Q
- .S GMRABGDT=$P(GMRA(0),U,4)
- .S ^TMP($J,"GMRAEF",GMRDFN,GMRABGDT)=GMRAIEN
- .Q
- D EN1^GMRAEF
- Q
- CMPFDA(DA) ; GIVEN DA ENTRY IN 120.8 RETURN 0 IF THERE IS INCOMPLETE
- ; FDA DATA, ELSE RETURN 1
- N X
- S X=0,Y=0 ; Pre set quit flag to valid
- ;loop through for each entry
- F S X=$O(^GMR(120.85,"C",DA,X)) Q:X'>0 D Q:'Y
- .S X(0)=$G(^GMR(120.85,X,0)) ; get the zero node
- .; Required data
- .I $P(X(0),U)="" Q ; Date/Time of Event
- .I $P(X(0),U,2)="" Q ; Patient
- .I $P(X(0),U,18)="" Q ; Date Reported
- .I $P(X(0),U,19)="" Q ; Reporting User
- .I '$O(^GMR(120.85,X,2,0)) Q ; Reaction
- .I '$O(^GMR(120.85,X,3,0)) Q ; Suspected Agent
- .S Y=1
- .I $P(X(0),U,3)'="" Q ; Question 1
- .I $P(X(0),U,4)'="" Q ; Question 2
- .I $P(X(0),U,5)'="" Q ; Question 3
- .I $P(X(0),U,6)'="" Q ; Question 4
- .I $P(X(0),U,7)'="" Q ; Question 5
- .I $P(X(0),U,9)'="" Q ; Question 6
- .I $P(X(0),U,10)'="" Q ; Question 7
- .I $P(X(0),U,11)'="" Q ; Question 8
- .I $P(X(0),U,16)'="" Q ; Question 9
- .I $P(X(0),U,17)'="" Q ; Question 10
- .S Y=0
- .Q
- Q Y
- EXIT ;EXIT OF ROUTINE
- K DIC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAEF1 2282 printed Mar 13, 2025@20:43:42 Page 2
- GMRAEF1 ;HIRMFO/WAA-FDA EXCEPTION REPORT ; 11/25/92
- +1 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
- EN1 ; Entry to PRINT PATIENT FDA EXCEPTION DATA option
- +1 KILL DIC
- SET GMRAOUT=0
- +2 WRITE !
- SET DIC="^DPT("
- SET DIC(0)="AEQM"
- +3 DO ^DIC
- KILL DIC,DLAYGO
- if +Y'>0
- GOTO EN1Q
- +4 SET GMRDFN=+Y
- DO EN2
- if 'GMRAOUT
- GOTO EN1
- EN1Q KILL GMRDFN,DIC,GMRAOUT
- +1 DO KILL^XUSCLEAN
- GOTO EXIT
- EN2 ;
- +1 SET GMRAX=$PIECE($GET(^GMR(120.86,GMRDFN,0)),U,2)
- IF GMRAX=0
- WRITE !,"This patient has No Known Allergies"
- KILL GMRAX
- QUIT
- +2 SET X=0
- FOR X=0:0
- SET X=$ORDER(^GMR(120.8,"B",GMRDFN,X))
- if X'>0
- QUIT
- IF '+$GET(^GMR(120.8,X,"ER"))
- SET X=X+1
- QUIT
- +3 IF 'X
- WRITE !,"This patient has no allergies on file"
- QUIT
- DDATE ;Select discharge date
- +1 KILL DIR
- SET DIR("A")="Enter the Date to start search (Time optional)"
- +2 SET DIR("B")="T-30"
- SET DIR(0)="DO^::AET"
- +3 SET DIR("?")="ENTER THE DATE YOU WANT THE SYSTEM TO START IT'S SEARCH"
- +4 DO ^DIR
- KILL DIR
- +5 IF "^^"[Y
- SET GMRAOUT=1
- GOTO EXIT
- +6 IF $DATA(DIRUT)
- GOTO EXIT
- +7 SET GMRASTDT=Y
- +8 SET GMRAIEN=0
- FOR
- SET GMRAIEN=$ORDER(^GMR(120.8,"B",GMRDFN,GMRAIEN))
- if GMRAIEN<1
- QUIT
- Begin DoDot:1
- +9 if +$GET(^GMR(120.8,GMRAIEN,"ER"))
- QUIT
- +10 SET GMRA(0)=$GET(^GMR(120.8,GMRAIEN,0))
- +11 if GMRA(0)=""
- QUIT
- +12 IF $PIECE(GMRA(0),U,6)'="o"!($PIECE(GMRA(0),U,20)'["D")
- QUIT
- +13 IF '$PIECE(GMRA(0),U,12)
- QUIT
- +14 IF $PIECE(GMRA(0),U,4)<GMRASTDT
- QUIT
- +15 IF $$CMPFDA(GMRAIEN)
- QUIT
- +16 SET GMRABGDT=$PIECE(GMRA(0),U,4)
- +17 SET ^TMP($JOB,"GMRAEF",GMRDFN,GMRABGDT)=GMRAIEN
- +18 QUIT
- End DoDot:1
- +19 DO EN1^GMRAEF
- +20 QUIT
- CMPFDA(DA) ; GIVEN DA ENTRY IN 120.8 RETURN 0 IF THERE IS INCOMPLETE
- +1 ; FDA DATA, ELSE RETURN 1
- +2 NEW X
- +3 ; Pre set quit flag to valid
- SET X=0
- SET Y=0
- +4 ;loop through for each entry
- +5 FOR
- SET X=$ORDER(^GMR(120.85,"C",DA,X))
- if X'>0
- QUIT
- Begin DoDot:1
- +6 ; get the zero node
- SET X(0)=$GET(^GMR(120.85,X,0))
- +7 ; Required data
- +8 ; Date/Time of Event
- IF $PIECE(X(0),U)=""
- QUIT
- +9 ; Patient
- IF $PIECE(X(0),U,2)=""
- QUIT
- +10 ; Date Reported
- IF $PIECE(X(0),U,18)=""
- QUIT
- +11 ; Reporting User
- IF $PIECE(X(0),U,19)=""
- QUIT
- +12 ; Reaction
- IF '$ORDER(^GMR(120.85,X,2,0))
- QUIT
- +13 ; Suspected Agent
- IF '$ORDER(^GMR(120.85,X,3,0))
- QUIT
- +14 SET Y=1
- +15 ; Question 1
- IF $PIECE(X(0),U,3)'=""
- QUIT
- +16 ; Question 2
- IF $PIECE(X(0),U,4)'=""
- QUIT
- +17 ; Question 3
- IF $PIECE(X(0),U,5)'=""
- QUIT
- +18 ; Question 4
- IF $PIECE(X(0),U,6)'=""
- QUIT
- +19 ; Question 5
- IF $PIECE(X(0),U,7)'=""
- QUIT
- +20 ; Question 6
- IF $PIECE(X(0),U,9)'=""
- QUIT
- +21 ; Question 7
- IF $PIECE(X(0),U,10)'=""
- QUIT
- +22 ; Question 8
- IF $PIECE(X(0),U,11)'=""
- QUIT
- +23 ; Question 9
- IF $PIECE(X(0),U,16)'=""
- QUIT
- +24 ; Question 10
- IF $PIECE(X(0),U,17)'=""
- QUIT
- +25 SET Y=0
- +26 QUIT
- End DoDot:1
- if 'Y
- QUIT
- +27 QUIT Y
- EXIT ;EXIT OF ROUTINE
- +1 KILL DIC
- +2 QUIT
