MCARUTL3.m

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

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