source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDPCE.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1MDPCE ; HIRMFO/NCA - Routine For Data Extract ; [05-28-2002 12:55]
2 ;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
3 ; Integration Agreements:
4 ; IA# 1889 [Subscription] Create New Visit
5 ;
6EN1(MDINST,MDPDTE,MDPR,MDTYP,MDETYP) ; [Function] PCE Visit Creation
7 ; Input parameters
8 ; 1. MDINST [Literal/Required] Transaction IEN
9 ; 2. MDPDT [Literal/Optional] Procedure Date/Time
10 ; 3. MDPR [Literal/Required] CP Definition
11 ; 4. MDTYP [Literal/Required] Type of Visit (Ambulatory or Hospitalization or Event (Historical))
12 ; 5. MDETYP [Literal/Required] Encounter Type (Primary or Ancillary)
13 ;
14 N DATA,MDCLOC,MDPERR,MDJ,MDPKG,MDRES,MDSTR,MDVISIT,MDDRES K ^TMP("MDPXAPI",$J)
15 S MDOUT=""
16 S MDPKG=$$FIND1^DIC(9.4,"","MX","CLINICAL PROCEDURES")
17 I 'MDPKG Q "-1^CLINICAL PROCEDURES does not exist in Package File."
18 I '$D(^MDD(702,MDINST,0)) Q "-1^No Study Record."
19 S MDSTR=$G(^MDD(702,MDINST,0))
20 S MDJ=0,MDJ=MDJ+1
21 S MDCLOC=$$GET1^DIQ(702.01,+MDPR_",",.05,"I")
22 I 'MDCLOC S:MDPR["^" MDCLOC=$P(MDPR,"^",2)
23 I 'MDCLOC Q "-1^No Hospital Location for CP Definition."
24 S ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"ENC D/T")=MDPDTE
25 S ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"PATIENT")=$P(MDSTR,"^",1)
26 S ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"HOS LOC")=MDCLOC
27 S ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"SERVICE CATEGORY")=MDTYP
28 S ^TMP("MDPXAPI",$J,"ENCOUNTER",MDJ,"ENCOUNTER TYPE")=MDETYP
29 S MDRES=$$DATA2PCE^PXAPI("^TMP(""MDPXAPI"",$J)",MDPKG,"CLINICAL PROCEDURES",.MDVISIT,"","",1,"",.MDPERR)
30 I MDRES S MDOUT=MDVISIT_"^"_MDCLOC_";"_MDPDTE_";"_MDTYP S MDFDA(702,MDINST_",",.07)=MDTYP_";"_MDPDTE_";"_MDCLOC D FILE^DIE("K","MDFDA") K ^TMP("MDPXAPI",$J) Q MDOUT
31 K ^TMP("MDPXAPI",$J)
32 S MDOUT="-1^PCE Visit Creation Error."
33 Q MDOUT
34 ;
Note: See TracBrowser for help on using the repository browser.