| 1 | MCARUTL3 ;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 | ;
|
|---|
| 6 | MEDLKUP(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
|
|---|
