Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BLRAG04

BLRAG04.m

Go to the documentation of this file.
  1. BLRAG04 ; IHS/MSC/SAT - LABORATORY ACCESSION GUI RPCS ;
  1. ;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997;Build 185
  1. ;
  1. ; BLR REF LAB USING LEDI - UL^BLRAG02 = return the value of the 'REF LAB USING LEDI?' field in the BLR MASTER CONTROL file
  1. ; BLR ICD LOOKUP - ICDLKUP^BLRAG07 = ICD code lookup
  1. ; BLR ORDER REASON LKUP - ORL^BLRAG07 = return order reasons from file 100.03
  1. ; BLR PATIENT LOOKUP - PTLK^BLRAG04 = Patient Lookup
  1. ; BLR PRINTERS AVAILABLE - DEVICE^BLRAG10 = return available printers from the DEVICE file
  1. ; BLR USER LOOKUP - NP^BLRAG06 = return entries from the NEW PERSON table 200 that are 'active'
  1. ;
  1. ; BLR ACCESSION - ACC^BLRAG05 = lab accession processor
  1. ; BLR ACCESSION PRINT - ABR^BLRAG02 = reprint accession label or manifest
  1. ; BLR ALL NON-ACCESSIONED - ANA^BLRAG01 = return all non-accessioned lab records
  1. ; BLR ALL-ACCESSIONED - ABD^BLRAG02 = return all accessioned records for given date range
  1. ; BLR COLLECTION INFO - BLC^BLRAG06 = check BLR PT CONFIRM parameter and return insurances for patient
  1. ; BLR DELETE TEST - DELTST^BLRAG08 = Cancel tests - Test are no longer deleted, instead the status is changed to Not Performed.
  1. ; BLR ORDER/TEST STATUS - LROS^BLRAG03 = return order/test status for given patient and date range
  1. ;
  1. ; BLR SHIP CONF - SC^BLRAG09A = select a shipping configuration
  1. ; BLR MANIFEST BUILD - BM^BLRAG09B = build a shipping manifest
  1. ; BLR MANIFEST CLOSE/SHIP - CLSHIP^BLRAG09C = Close/ship a shipping manifest
  1. ; BLR MANIFEST DISPLAY - DISP^BLRAG09G = screen formatted text for manifest display
  1. ; BLR MANIFEST START - SMONLY^BLRAG09C = Start a shipping manifest only, no building
  1. ; BLR MANIFEST TEST ADD - ADDTEST^BLRAG09C= Add tests to an existing manifest\
  1. ; BLR MANIFEST TEST REMOVE - REMVTST^BLRAG09C= Remove a test from manifest - actually flags test as "removed".
  1. ; BLR MANIFEST TESTS TO ADD- TARPC^BLRAG09B = return tests that can be added to a manifest
  1. ;
  1. PTLK(BDGY,BDGP,BDGC,BDGGIEN,BDGADM) ;EP Patient Lookup
  1. ;
  1. ; RPC: BLR PATIENT LOOKUP
  1. ;INPUT
  1. ; BDGP = (required) Partail patient name; Could also be DOB, SSN, or chart #.
  1. ; BDGC = (optional) Max number of patients returned; defaults to 10
  1. ; BDGGIEN = (optional) Specific IEN of patient
  1. ; BDGADM = (optional) flag to only return patients that are currently
  1. ; admitted; 0=all patients; 1=admitted patients only
  1. ;RETURNS:
  1. ; (0) NAME
  1. ; (1) HRN
  1. ; (2) SSN
  1. ; (3) DOB
  1. ; (4) IEN
  1. ; (5) STATUS
  1. ; (6) GENDER
  1. ; (7) ADMISSION_IEN
  1. ; (8) INPATIENT_STATUS
  1. ; (9) WARD
  1. ; (10) ROOM_BED
  1. ; (11) TREATING_SPEC
  1. ; (12) PRIM_PHYS
  1. ; (13) ATT_PHYS
  1. ; (14) ADMITTING_PROVIDER
  1. ; (15) LAST_EDITED_BY
  1. ; (16) LAST_EDITED_DATE
  1. ; (17) DISCHARGE_IEN
  1. ; (18) DISCHARGE_TYPE
  1. ; (19) DATE_OF_DEATH
  1. ; (20) CITY
  1. ; (21) STATE
  1. ;
  1. ;Find up to BDGC patients matching BDGP*
  1. ;Supports DOB Lookup, SSN Lookup
  1. ;
  1. ;BDGADM - if passed, only return patients that are currently admitted.
  1. ;
  1. N BDGXI
  1. S BDGP=$G(BDGP,"")
  1. S:$G(BDGC)="" BDGC=10
  1. S BDGY=$NA(^TMP("BLRAG",$J)) K @BDGY
  1. S BDGXI=0
  1. N BDGHRN,BDGZ,BDGDLIM,BDGRET,BDGDPT,BDGRET,BDGIEN,BDGFILE
  1. N BDGIENS,BDGFIELDS,BDGFLAGS,BDGVALUE,BDGNUMBER,BDGINDEXES,BDGSCREEN
  1. N BDGTARG,BDGMSG,BDGRSLT,BDGCNT
  1. S BDGDLIM="^"
  1. S @BDGY@(0)="ERROR_ID"
  1. I '+$G(DUZ) Q
  1. I '$D(DUZ(2)) Q
  1. ; 0 1 2 3 4 5 6 7 8 9 10 11 12
  1. S @BDGY@(BDGXI)="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN^T00030STATUS^T00010GENDER^I00020ADMISSION_IEN^T00030INPATIENT_STATUS^T00030WARD^T00030ROOM_BED^I00020TREATING_SPEC^I00020PRIM_PHYS^"
  1. ; 13 14 15 16 17 18 19
  1. S @BDGY@(BDGXI)=@BDGY@(BDGXI)_"I00020ATT_PHYS^T00030ADMITTING_PROVIDER^I00020LAST_EDITED_BY^D00020LAST_EDITED_DATE^I00030DISCHARGE_IEN^T00030DISCHARGE_TYPE^D00020DATE_OF_DEATH"
  1. ; 20 21
  1. S @BDGY@(BDGXI)=@BDGY@(BDGXI)_"T00020CITY^T00020STATE"
  1. S BDGXI=BDGXI+1
  1. I $G(BDGGIEN) D DATA(.BDGY,BDGGIEN,BDGXI) Q
  1. ;
  1. DOB ;DOB Lookup
  1. I +DUZ(2),((BDGP?1.2N1"/"1.2N1"/"1.4N)!(BDGP?1.2N1" "1.2N1" "1.4N)!(BDGP?1.2N1"-"1.2N1"-"1.4N)!(BDGP?1.2N1"."1.2N1"."1.4N)) D Q
  1. . S X=BDGP S %DT="P" D ^%DT S BDGP=Y Q:'+Y
  1. . Q:'$D(^DPT("ADOB",BDGP))
  1. . S BDGIEN=0 F S BDGIEN=$O(^DPT("ADOB",BDGP,BDGIEN)) Q:'+BDGIEN D
  1. . . Q:'$D(^DPT(BDGIEN,0))
  1. . . I $G(BDGADM) Q:'$$STATUS(BDGIEN,1)
  1. . . D DATA(.BDGY,BDGIEN,.BDGXI)
  1. . . Q
  1. . Q
  1. ;
  1. ;Chart# Lookup
  1. I +DUZ(2),BDGP]"",$D(^AUPNPAT("D",BDGP)) D Q
  1. . S BDGIEN=0 F S BDGIEN=$O(^AUPNPAT("D",BDGP,BDGIEN)) Q:'+BDGIEN I $D(^AUPNPAT("D",BDGP,BDGIEN,DUZ(2))) D Q
  1. . . Q:'$D(^DPT(BDGIEN,0))
  1. . . I $G(BDGADM) Q:'$$STATUS(BDGIEN,1)
  1. . . D DATA(.BDGY,BDGIEN,.BDGXI)
  1. . . Q
  1. . Q
  1. ;
  1. ;SSN Lookup
  1. I (BDGP?9N)!(BDGP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BDGP)) D Q
  1. . Q
  1. . S BDGIEN=0 F S BDGIEN=$O(^DPT("SSN",BDGP,BDGIEN)) Q:'+BDGIEN D Q
  1. . . Q:'$D(^DPT(BDGIEN,0))
  1. . . I $G(BDGADM) Q:'$$STATUS(BDGIEN,1)
  1. . . D DATA(.BDGY,BDGIEN,.BDGXI)
  1. . . Q
  1. . Q
  1. ;
  1. ;All Patients
  1. I BDGP="" D Q
  1. . D LISTALL^BEHOPTPL(.PLIST,"",1)
  1. . S BDGCNT=0 F S BDGCNT=$O(PLIST(BDGCNT)) Q:'BDGCNT!(BDGCNT>$G(BDGC)) D
  1. . . I $G(BDGADM) Q:'$$STATUS($P(PLIST(BDGCNT),U,1),1)
  1. . . D DATA(.BDGY,$P(PLIST(BDGCNT),U,1),.BDGXI)
  1. . . Q
  1. . Q
  1. ;
  1. S BDGFILE=2
  1. S BDGIENS=""
  1. S BDGFIELDS=".01"
  1. S BDGFLAGS=""
  1. S BDGVALUE=BDGP
  1. S BDGNUMBER=BDGC
  1. S BDGINDEXES="B"
  1. S BDGSCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")
  1. S BDGIDEN=""
  1. S BDGTARG="BDGRSLT"
  1. S BDGMSG=""
  1. D FIND^DIC(BDGFILE,BDGIENS,BDGFIELDS,BDGFLAGS,BDGVALUE,BDGNUMBER,BDGINDEXES,BDGSCREEN,BDGIDEN,BDGTARG,BDGMSG)
  1. I '+$G(BDGRSLT("DILIST",0)) Q
  1. N BDGCNT S BDGCNT=2
  1. F BDGX=1:1:$P(BDGRSLT("DILIST",0),U) D
  1. . S BDGIEN=BDGRSLT("DILIST",2,BDGX)
  1. . I $G(BDGADM) Q:'$$STATUS(BDGIEN,1)
  1. . D DATA(.BDGY,BDGIEN,.BDGXI)
  1. . Q
  1. Q
  1. ;
  1. DATA(BDGY,BDGIEN,BDGXI) ;
  1. S BDGDPT=$G(^DPT(BDGIEN,0))
  1. S BDGZ=$P(BDGDPT,U)
  1. S BDGHRN=$P($G(^AUPNPAT(BDGIEN,41,DUZ(2),0)),U,2) ;CHART
  1. I BDGHRN="" Q ;NO CHART AT THIS DUZ2
  1. I $P($G(^AUPNPAT(BDGIEN,41,DUZ(2),0)),U,3) S BDGHRN=BDGHRN_"(*)" Q ;HMW 20050721 Record Inactivated
  1. S $P(BDGZ,BDGDLIM,2)=BDGHRN
  1. S $P(BDGZ,BDGDLIM,3)=$P(BDGDPT,U,9) ;SSN
  1. S Y=$P(BDGDPT,U,3) X ^DD("DD")
  1. S $P(BDGZ,BDGDLIM,4)=Y ;DOB
  1. S $P(BDGZ,BDGDLIM,5)=BDGIEN
  1. S $P(BDGZ,BDGDLIM,6)=$$STATUS(BDGIEN)
  1. S $P(BDGZ,BDGDLIM,7)=$$SEX^AUPNPAT(BDGIEN)_"^"_$$INP(BDGIEN)
  1. S $P(BDGZ,BDGDLIM,21)=$$GET1^DIQ(2,BDGIEN_",",.114) ;get city
  1. S $P(BDGZ,BDGDLIM,22)=$$GET1^DIQ(2,BDGIEN_",",.115) ;get state
  1. S DFN=BDGIEN I $G(DFN) S $P(BDGZ,BDGDLIM,20)=$$DOD^AUPNPAT(DFN) ; Date of Death
  1. S @BDGY@(BDGXI)=BDGZ,BDGXI=BDGXI+1
  1. Q
  1. STATUS(DFN,CHECK) ;
  1. N STATUS,A,INP
  1. I 'DFN Q ""
  1. K VAIN
  1. I $G(CHECK) D Q INP
  1. .D IN5^VADPT
  1. .I $G(VAIP(1)) S INP=1 Q
  1. .S INP=0
  1. D INP^DGPMV10,Q^VADPT3
  1. S A=$S("^3^5^"[("^"_+DGPMVI(2)_"^"):0,1:+DGPMVI(2))
  1. S STATUS=$S('A:"IN",1:"")_"ACTIVE "_$S("^4^5^"[("^"_+DGPMVI(2)_"^"):"LODGER",$P(DGPMVI(8),"^",2)["OBSERVATION":"OBSERVATION PATIENT",1:"INPATIENT")
  1. Q STATUS
  1. INP(DFN) ;
  1. N BDGINP,BDGWARD,BDGRMBD,BDGIEN,BDGTRSP,BDGPPHYS,BDGAPHYS,BDGLEBY,BDGLEON,BDGADIS,BDGDIST,BDGADMPV
  1. N BDGARY
  1. K VAIN
  1. S BDGINP=0
  1. D INP^VADPT M BDGARY=VAIN
  1. S BDGIEN=+$G(VAIN(1)) I BDGIEN S BDGINP=1
  1. I 'BDGINP D INP^DGPMV10 S BDGDIEN=$G(DGPMVI(1))
  1. I 'BDGINP S BDGIEN=$$GET1^DIQ(405,BDGDIEN,.14,"I")
  1. S BDGLEBY=$$GET1^DIQ(405,$S(BDGINP:BDGIEN,1:BDGDIEN),102,"I")
  1. S BDGLEON=$$GET1^DIQ(405,$S(BDGINP:BDGIEN,1:BDGDIEN),103,"I")
  1. S BDGPPHYS=$P(BDGARY(2),U)
  1. S BDGTRSP=$P(BDGARY(3),U)
  1. S BDGWARD=$P(BDGARY(4),U)
  1. S BDGRMBD=$P(BDGARY(5),U) I BDGRMBD]"" S BDGRMBD=$O(^DG(405.4,"B",BDGRMBD,0))
  1. S BDGAPHYS=$P(BDGARY(11),U)
  1. S BDGADIS=$$GET1^DIQ(405,BDGIEN,.17,"I")
  1. I BDGADIS D
  1. .S BDGDIST=$$GET1^DIQ(405,BDGADIS,.04,"E")
  1. S BDGADMPV=$$GET1^DIQ(405,BDGIEN,9999999.02,"E")
  1. Q BDGIEN_U_BDGINP_U_BDGWARD_U_BDGRMBD_U_BDGTRSP_U_BDGPPHYS_U_BDGAPHYS_U_BDGADMPV_U_BDGLEBY_U_BDGLEON_U_BDGADIS_U_$G(BDGDIST)
  1. ;