source: FOIAVistA/tag/r/MEDICINE-MC/MCARUTL3.m@ 1590

Last change on this file since 1590 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1MCARUTL3 ;HOIFO/WAA-Utility Routine #3;11/29/00 09:55
2 ;;2.3;Medicine;**30**;09/13/1996
3 ;;
4 ;;This API is referenced in DBIA 3280
5 ;
6MEDLKUP(ARRAY,FN,IEN) ; This sub-routine will return the following information
7 ; Input:
8 ; ARRAY = the array for the return array
9 ; FN = the medicine file number
10 ; IEN = the Internal Entry Number
11 ; Output:
12 ; piece 1 =0 (failure) or 1 (success, 2nd piece is message text.)
13 ; piece 2 = Medicine file
14 ; piece 3 = Medicine ien
15 ; piece 4 & 5 =Medicine patient (internal ^ external)
16 ; piece 6 & 7 =Medicine date/time (internal ^ external)
17 ; piece 8 & 9 =Medicine Procedure (internal ^ external)
18 ; piece 10 & 11 =i~_Image (Med,2005,IEN) ^ external pointer to 2005)
19 N LINE,PDATE,EDATE,DFN,PATNAM,PROC,PROCN,IMG,IMAGE,DILN,%,I,DISYS
20 S ARRAY=0
21 S FN=$G(FN) I FN="" S ARRAY="0^No File indicated." Q
22 I FN=690 S ARRAY="0^Cannot look-up on MEDICAL PATIENT File." Q
23 I FN<690!(FN>701) S ARRAY="0^Non-Medicine File indicated." Q
24 I FN=697.2 S ARRAY="0^Cannot look-up on PROCEDURE/SUBSPECIALTY File." Q
25 I ($O(^MCAR(697.2,"C","MCAR("_FN,0)))<1 S ARRAY="0^"_FN_" is not a procedure file." Q
26 S IEN=$G(IEN) I IEN="" S ARRAY="0^No IEN indicated." Q
27 S LINE=$G(^MCAR(FN,IEN,0))
28 I LINE="" S ARRAY="0^Entry "_IEN_" in file "_FN_" not found." Q
29 S PDATE=$P(LINE,U,1) ; Procedure Date
30 I PDATE<1 S ARRAY="0^Incomplete data, NO Procedure Date in entry "_IEN_" for file "_FN Q
31 S EDATE=$$FMTE^XLFDT(PDATE,8) ; External Date
32 S DFN=$P(LINE,U,2) ; Get Patient
33 I DFN<1 S ARRAY="0^Incomplete data, NO Patient in entry "_IEN_" for file "_FN Q
34 S PATNAM=$$GET1^DIQ(2,DFN_",",.01,"I") ; Patient Name
35 S PROC="" ; setup for getting indicated procedure
36 I FN=699 S PROC=$P(LINE,U,12) ; Screening
37 I FN=699.5 S PROC=$P(LINE,U,6) ; Screening
38 I FN=694 S PROC=$P(LINE,U,3) ; Screening
39 I PROC="" S PROC=$O(^MCAR(697.2,"C","MCAR("_FN,0)) ; Verify the procedure
40 I PROC<1 S ARRAY="0^No Procedure indicated." Q ; Bad Procedure
41 S PROCN=$P($G(^MCAR(697.2,PROC,0)),U) ; get procedure number
42 I PROCN="" S ARRAY="0^No Procedure Name indicated." Q ; again Bad
43 S ARRAY="1"_U_FN_U_IEN_U_DFN_U_PATNAM_U_PDATE_U_EDATE_U_PROC_U_PROCN
44 S IMG=+$P($G(^MCAR(FN,IEN,2005,0)),U,3) I IMG D
45 . S IMAGE=+$P($G(^MCAR(FN,IEN,2005,IMG,0)),U)
46 . S ARRAY=ARRAY_U_IMG_U_IMAGE
47 . Q
48 ; Getting Image and passing back
49 Q
Note: See TracBrowser for help on using the repository browser.