50 lines
2.3 KiB
Mathematica
50 lines
2.3 KiB
Mathematica
MCARUTL3 ;HOIFO/WAA-Utility Routine #3;11/29/00 09:55
|
|
;;2.3;Medicine;**30**;09/13/1996
|
|
;;
|
|
;;This API is referenced in DBIA 3280
|
|
;
|
|
MEDLKUP(ARRAY,FN,IEN) ; This sub-routine will return the following information
|
|
; Input:
|
|
; ARRAY = the array for the return array
|
|
; FN = the medicine file number
|
|
; IEN = the Internal Entry Number
|
|
; Output:
|
|
; piece 1 =0 (failure) or 1 (success, 2nd piece is message text.)
|
|
; piece 2 = Medicine file
|
|
; piece 3 = Medicine ien
|
|
; piece 4 & 5 =Medicine patient (internal ^ external)
|
|
; piece 6 & 7 =Medicine date/time (internal ^ external)
|
|
; piece 8 & 9 =Medicine Procedure (internal ^ external)
|
|
; piece 10 & 11 =i~_Image (Med,2005,IEN) ^ external pointer to 2005)
|
|
N LINE,PDATE,EDATE,DFN,PATNAM,PROC,PROCN,IMG,IMAGE,DILN,%,I,DISYS
|
|
S ARRAY=0
|
|
S FN=$G(FN) I FN="" S ARRAY="0^No File indicated." Q
|
|
I FN=690 S ARRAY="0^Cannot look-up on MEDICAL PATIENT File." Q
|
|
I FN<690!(FN>701) S ARRAY="0^Non-Medicine File indicated." Q
|
|
I FN=697.2 S ARRAY="0^Cannot look-up on PROCEDURE/SUBSPECIALTY File." Q
|
|
I ($O(^MCAR(697.2,"C","MCAR("_FN,0)))<1 S ARRAY="0^"_FN_" is not a procedure file." Q
|
|
S IEN=$G(IEN) I IEN="" S ARRAY="0^No IEN indicated." Q
|
|
S LINE=$G(^MCAR(FN,IEN,0))
|
|
I LINE="" S ARRAY="0^Entry "_IEN_" in file "_FN_" not found." Q
|
|
S PDATE=$P(LINE,U,1) ; Procedure Date
|
|
I PDATE<1 S ARRAY="0^Incomplete data, NO Procedure Date in entry "_IEN_" for file "_FN Q
|
|
S EDATE=$$FMTE^XLFDT(PDATE,8) ; External Date
|
|
S DFN=$P(LINE,U,2) ; Get Patient
|
|
I DFN<1 S ARRAY="0^Incomplete data, NO Patient in entry "_IEN_" for file "_FN Q
|
|
S PATNAM=$$GET1^DIQ(2,DFN_",",.01,"I") ; Patient Name
|
|
S PROC="" ; setup for getting indicated procedure
|
|
I FN=699 S PROC=$P(LINE,U,12) ; Screening
|
|
I FN=699.5 S PROC=$P(LINE,U,6) ; Screening
|
|
I FN=694 S PROC=$P(LINE,U,3) ; Screening
|
|
I PROC="" S PROC=$O(^MCAR(697.2,"C","MCAR("_FN,0)) ; Verify the procedure
|
|
I PROC<1 S ARRAY="0^No Procedure indicated." Q ; Bad Procedure
|
|
S PROCN=$P($G(^MCAR(697.2,PROC,0)),U) ; get procedure number
|
|
I PROCN="" S ARRAY="0^No Procedure Name indicated." Q ; again Bad
|
|
S ARRAY="1"_U_FN_U_IEN_U_DFN_U_PATNAM_U_PDATE_U_EDATE_U_PROC_U_PROCN
|
|
S IMG=+$P($G(^MCAR(FN,IEN,2005,0)),U,3) I IMG D
|
|
. S IMAGE=+$P($G(^MCAR(FN,IEN,2005,IMG,0)),U)
|
|
. S ARRAY=ARRAY_U_IMG_U_IMAGE
|
|
. Q
|
|
; Getting Image and passing back
|
|
Q
|