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 Dec 13, 2024@01:39:40 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
