- GMRAOR3 ;HIRMFO/RM,WAA-ORDERABLE LIST UTILITIES ; 11/29/07 12:17pm
- ;;4.0;Adverse Reaction Tracking;**13,41**;Mar 29, 1996;Build 8
- ;;THIS ROUTINE IS NO LONGER IN USE THUS THE REFERENCES TO PHARMACY
- ;;GLOBALS DO NOT NEED TO BE REMOVED
- ;;THIS ROUTINE MAY BE DELETED ON SOME FUTURE DATE
- ;
- EN1(START,NUM,ARRAY) ; ENTRY POINT WHERE ALL VARIABLES ARE OPTIONAL.
- ; START IS THE STARTING POINT OF LIST TO BE RETURNED, NUM IS
- ; THE NUMBER OF ENTRIES FROM STARTING POINT TO INCLUDE IN LIST,
- ; AND ARRAY IS THE ADDRESS OF THE ARRAY LIST IS TO BE RETURNED.
- ;
- K:$G(START)="" START ; Force list to start at "A" and skip num./punc.
- S START=$G(START,"A"),NUM=$G(NUM),ARRAY=$G(ARRAY,"GMRALST")
- K ^TMP($J,"GMRALST")
- NODE ;Loop through each file in order of X-ref.
- ;
- ; Loop through GMR Allergies file.
- S GMRAST=START
- F GMRACNT=1:1 Q:NUM&(GMRACNT>NUM) S GMRAST=$O(^GMRD(120.82,"B",GMRAST)) Q:GMRAST="" S GMRAIEN=$O(^(GMRAST,"")) I GMRAIEN>0 D FILE("ALL",0)
- ;
- ; Loop through VA Drug Class file.
- ; THIS ROUTINE IS NOT IN USE THUS THE DIRECT PHARMACY READ DOES NOT
- ; NEED TO BE UPDATED
- S GMRAST=START
- F GMRACNT=1:1 Q:NUM&(GMRACNT>NUM) S GMRAST=$O(^PS(50.605,"C",GMRAST)) Q:GMRAST="" S GMRAIEN=$O(^(GMRAST,"")) I GMRAIEN>0 D FILE("PSC",0)
- ;
- ; Loop through NDF File (B X-ref)
- ; $$B^PSNAPIS returns NDF version dependent root of "B" x-ref
- ; THIS ROUTINE IS NOT IN USE THUS THE DIRECT PHARMACY READ DOES NOT
- ; NEED TO BE UPDATED
- S GMRAST=START
- F GMRACNT=1:1 Q:NUM&(GMRACNT>NUM) S GMRAST=$O(@($$B^PSNAPIS)@(GMRAST)) Q:GMRAST="" S GMRAIEN=$O(^(GMRAST,"")) I GMRAIEN>0 D FILE("NDF",0)
- ;
- ; Loop through NDF file (T X-ref)
- ; $$T^PSNAPIS returns NDF version dependent root of "T" x-ref
- ; THIS ROUTINE IS NOT IN USE THUS THE DIRECT PHARMACY READ DOES NOT
- ; NEED TO BE UPDATED
- S GMRAST=START K ^TMP($J,"GMRAT")
- F GMRACNT=1:1 Q:NUM&(GMRACNT>NUM) S GMRAST=$O(@($$T^PSNAPIS)@(GMRAST)) Q:GMRAST="" S GMRAIEN=$$TGTOG^PSNAPIS(GMRAST) I GMRAIEN>0 D FILE("NDF",1)
- ; Set the return array.
- S GMRACNT=1,GMRAST="" F S GMRAST=$O(^TMP($J,"GMRALST",GMRAST)) Q:GMRAST="" D I NUM'="" Q:GMRACNT>NUM
- .S @ARRAY@(GMRACNT)=^TMP($J,"GMRALST",GMRAST),GMRACNT=GMRACNT+1
- .Q
- K ^TMP($J,"GMRALST"),^TMP($J,"GMRAT"),GMRACNT,GMRAIEN,GMRAST
- Q
- FILE(GMRATAB,GMRAT) ;File away a found entry
- ; GMRATAB is the table entry in from OE3 HL7 spec.
- ; GMRAT is (0/1) indicating whether to check for dups of same entry.
- ;
- I GMRAT Q:$D(^TMP($J,"GMRAT",GMRAIEN)) S ^(GMRAIEN)=""
- I '$D(^TMP($J,"GMRALST",GMRAST)) S ^(GMRAST)=GMRAIEN_U_GMRAST_U_"99"_GMRATAB
- K GMRAT,GMRATAB
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAOR3 2615 printed Mar 13, 2025@20:44:20 Page 2
- GMRAOR3 ;HIRMFO/RM,WAA-ORDERABLE LIST UTILITIES ; 11/29/07 12:17pm
- +1 ;;4.0;Adverse Reaction Tracking;**13,41**;Mar 29, 1996;Build 8
- +2 ;;THIS ROUTINE IS NO LONGER IN USE THUS THE REFERENCES TO PHARMACY
- +3 ;;GLOBALS DO NOT NEED TO BE REMOVED
- +4 ;;THIS ROUTINE MAY BE DELETED ON SOME FUTURE DATE
- +5 ;
- EN1(START,NUM,ARRAY) ; ENTRY POINT WHERE ALL VARIABLES ARE OPTIONAL.
- +1 ; START IS THE STARTING POINT OF LIST TO BE RETURNED, NUM IS
- +2 ; THE NUMBER OF ENTRIES FROM STARTING POINT TO INCLUDE IN LIST,
- +3 ; AND ARRAY IS THE ADDRESS OF THE ARRAY LIST IS TO BE RETURNED.
- +4 ;
- +5 ; Force list to start at "A" and skip num./punc.
- if $GET(START)=""
- KILL START
- +6 SET START=$GET(START,"A")
- SET NUM=$GET(NUM)
- SET ARRAY=$GET(ARRAY,"GMRALST")
- +7 KILL ^TMP($JOB,"GMRALST")
- NODE ;Loop through each file in order of X-ref.
- +1 ;
- +2 ; Loop through GMR Allergies file.
- +3 SET GMRAST=START
- +4 FOR GMRACNT=1:1
- if NUM&(GMRACNT>NUM)
- QUIT
- SET GMRAST=$ORDER(^GMRD(120.82,"B",GMRAST))
- if GMRAST=""
- QUIT
- SET GMRAIEN=$ORDER(^(GMRAST,""))
- IF GMRAIEN>0
- DO FILE("ALL",0)
- +5 ;
- +6 ; Loop through VA Drug Class file.
- +7 ; THIS ROUTINE IS NOT IN USE THUS THE DIRECT PHARMACY READ DOES NOT
- +8 ; NEED TO BE UPDATED
- +9 SET GMRAST=START
- +10 FOR GMRACNT=1:1
- if NUM&(GMRACNT>NUM)
- QUIT
- SET GMRAST=$ORDER(^PS(50.605,"C",GMRAST))
- if GMRAST=""
- QUIT
- SET GMRAIEN=$ORDER(^(GMRAST,""))
- IF GMRAIEN>0
- DO FILE("PSC",0)
- +11 ;
- +12 ; Loop through NDF File (B X-ref)
- +13 ; $$B^PSNAPIS returns NDF version dependent root of "B" x-ref
- +14 ; THIS ROUTINE IS NOT IN USE THUS THE DIRECT PHARMACY READ DOES NOT
- +15 ; NEED TO BE UPDATED
- +16 SET GMRAST=START
- +17 FOR GMRACNT=1:1
- if NUM&(GMRACNT>NUM)
- QUIT
- SET GMRAST=$ORDER(@($$B^PSNAPIS)@(GMRAST))
- if GMRAST=""
- QUIT
- SET GMRAIEN=$ORDER(^(GMRAST,""))
- IF GMRAIEN>0
- DO FILE("NDF",0)
- +18 ;
- +19 ; Loop through NDF file (T X-ref)
- +20 ; $$T^PSNAPIS returns NDF version dependent root of "T" x-ref
- +21 ; THIS ROUTINE IS NOT IN USE THUS THE DIRECT PHARMACY READ DOES NOT
- +22 ; NEED TO BE UPDATED
- +23 SET GMRAST=START
- KILL ^TMP($JOB,"GMRAT")
- +24 FOR GMRACNT=1:1
- if NUM&(GMRACNT>NUM)
- QUIT
- SET GMRAST=$ORDER(@($$T^PSNAPIS)@(GMRAST))
- if GMRAST=""
- QUIT
- SET GMRAIEN=$$TGTOG^PSNAPIS(GMRAST)
- IF GMRAIEN>0
- DO FILE("NDF",1)
- +25 ; Set the return array.
- +26 SET GMRACNT=1
- SET GMRAST=""
- FOR
- SET GMRAST=$ORDER(^TMP($JOB,"GMRALST",GMRAST))
- if GMRAST=""
- QUIT
- Begin DoDot:1
- +27 SET @ARRAY@(GMRACNT)=^TMP($JOB,"GMRALST",GMRAST)
- SET GMRACNT=GMRACNT+1
- +28 QUIT
- End DoDot:1
- IF NUM'=""
- if GMRACNT>NUM
- QUIT
- +29 KILL ^TMP($JOB,"GMRALST"),^TMP($JOB,"GMRAT"),GMRACNT,GMRAIEN,GMRAST
- +30 QUIT
- FILE(GMRATAB,GMRAT) ;File away a found entry
- +1 ; GMRATAB is the table entry in from OE3 HL7 spec.
- +2 ; GMRAT is (0/1) indicating whether to check for dups of same entry.
- +3 ;
- +4 IF GMRAT
- if $DATA(^TMP($JOB,"GMRAT",GMRAIEN))
- QUIT
- SET ^(GMRAIEN)=""
- +5 IF '$DATA(^TMP($JOB,"GMRALST",GMRAST))
- SET ^(GMRAST)=GMRAIEN_U_GMRAST_U_"99"_GMRATAB
- +6 KILL GMRAT,GMRATAB
- +7 QUIT
