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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARUTL3 2397 printed Apr 09, 2024@21:14:18 Page 2
MCARUTL3 ;HOIFO/WAA-Utility Routine #3;11/29/00 09:55
+1 ;;2.3;Medicine;**30**;09/13/1996
+2 ;;
+3 ;;This API is referenced in DBIA 3280
+4 ;
MEDLKUP(ARRAY,FN,IEN) ; This sub-routine will return the following information
+1 ; Input:
+2 ; ARRAY = the array for the return array
+3 ; FN = the medicine file number
+4 ; IEN = the Internal Entry Number
+5 ; Output:
+6 ; piece 1 =0 (failure) or 1 (success, 2nd piece is message text.)
+7 ; piece 2 = Medicine file
+8 ; piece 3 = Medicine ien
+9 ; piece 4 & 5 =Medicine patient (internal ^ external)
+10 ; piece 6 & 7 =Medicine date/time (internal ^ external)
+11 ; piece 8 & 9 =Medicine Procedure (internal ^ external)
+12 ; piece 10 & 11 =i~_Image (Med,2005,IEN) ^ external pointer to 2005)
+13 NEW LINE,PDATE,EDATE,DFN,PATNAM,PROC,PROCN,IMG,IMAGE,DILN,%,I,DISYS
+14 SET ARRAY=0
+15 SET FN=$GET(FN)
IF FN=""
SET ARRAY="0^No File indicated."
QUIT
+16 IF FN=690
SET ARRAY="0^Cannot look-up on MEDICAL PATIENT File."
QUIT
+17 IF FN<690!(FN>701)
SET ARRAY="0^Non-Medicine File indicated."
QUIT
+18 IF FN=697.2
SET ARRAY="0^Cannot look-up on PROCEDURE/SUBSPECIALTY File."
QUIT
+19 IF ($ORDER(^MCAR(697.2,"C","MCAR("_FN,0)))<1
SET ARRAY="0^"_FN_" is not a procedure file."
QUIT
+20 SET IEN=$GET(IEN)
IF IEN=""
SET ARRAY="0^No IEN indicated."
QUIT
+21 SET LINE=$GET(^MCAR(FN,IEN,0))
+22 IF LINE=""
SET ARRAY="0^Entry "_IEN_" in file "_FN_" not found."
QUIT
+23 ; Procedure Date
SET PDATE=$PIECE(LINE,U,1)
+24 IF PDATE<1
SET ARRAY="0^Incomplete data, NO Procedure Date in entry "_IEN_" for file "_FN
QUIT
+25 ; External Date
SET EDATE=$$FMTE^XLFDT(PDATE,8)
+26 ; Get Patient
SET DFN=$PIECE(LINE,U,2)
+27 IF DFN<1
SET ARRAY="0^Incomplete data, NO Patient in entry "_IEN_" for file "_FN
QUIT
+28 ; Patient Name
SET PATNAM=$$GET1^DIQ(2,DFN_",",.01,"I")
+29 ; setup for getting indicated procedure
SET PROC=""
+30 ; Screening
IF FN=699
SET PROC=$PIECE(LINE,U,12)
+31 ; Screening
IF FN=699.5
SET PROC=$PIECE(LINE,U,6)
+32 ; Screening
IF FN=694
SET PROC=$PIECE(LINE,U,3)
+33 ; Verify the procedure
IF PROC=""
SET PROC=$ORDER(^MCAR(697.2,"C","MCAR("_FN,0))
+34 ; Bad Procedure
IF PROC<1
SET ARRAY="0^No Procedure indicated."
QUIT
+35 ; get procedure number
SET PROCN=$PIECE($GET(^MCAR(697.2,PROC,0)),U)
+36 ; again Bad
IF PROCN=""
SET ARRAY="0^No Procedure Name indicated."
QUIT
+37 SET ARRAY="1"_U_FN_U_IEN_U_DFN_U_PATNAM_U_PDATE_U_EDATE_U_PROC_U_PROCN
+38 SET IMG=+$PIECE($GET(^MCAR(FN,IEN,2005,0)),U,3)
IF IMG
Begin DoDot:1
+39 SET IMAGE=+$PIECE($GET(^MCAR(FN,IEN,2005,IMG,0)),U)
+40 SET ARRAY=ARRAY_U_IMG_U_IMAGE
+41 QUIT
End DoDot:1
+42 ; Getting Image and passing back
+43 QUIT
