source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDPS4.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: 3.2 KB
Line 
1MDPS4 ; HOIFO/NCA - Retrieve List of Consult Procedures ;1/26/06 12:45
2 ;;1.0;CLINICAL PROCEDURES;**13**;Apr 01, 2004;Build 19
3 ; Integration Agreements:
4 ; Reference IA# 2740 [Subscription] Routine GMRCSLM1.
5 ; IA# 2693 [Subscription] TIU Extractions.
6 ; IA# 2944 [Subscription] Calls to TIUSRVR1.
7 ; IA# 3067 [Private] Read fields in Consult file (#123) w/FM
8 ; IA# 4792 [Private] CANDO^TIUSRVA call
9 ;
10GP(MDDFN,MDSDT,MDEDT) ; Gather the completed procedure list
11 N MDCPR,MDCK,MDCPRO,MDCX,MDDTE,MDLP,MDFIL,MDX4,MDSTK,MDX S MDSTK="2,9",MDFIL=123
12 D OER^GMRCSLM1(MDDFN,"",MDSDT,MDEDT,MDSTK,1)
13 I $G(^TMP("GMRCR",$J,"CS",1,0))["< PATIENT DOES NOT HAVE ANY CONSULTS/REQUESTS" Q
14 S MDLP=0 F S MDLP=$O(^TMP("GMRCR",$J,"CS",MDLP)) Q:MDLP="AD"!(MDLP<1) S MDX=$G(^(MDLP,0)) D
15 .S MDCPRO=$P(MDX,U,5),MDX=+MDX
16 .Q:$$GET1^DIQ(MDFIL,+MDX_",",13,"I")'="P"
17 .;S MDFIL=123,MDCPR=$$GET1^DIQ(MDFIL,+MDX_",",4,"I")
18 .;Q:MDCPR'["GMR(123.3"
19 .;S MDCPR=+MDCPR S MDFIL=123.3 Q:'$$GET1^DIQ(MDFIL,+MDCPR_",",.05,"I")
20 .Q:$O(^MDD(702,"ACON",+MDX,0))
21 .S MDFIL=123 K MDCX D GETS^DIQ(MDFIL,+MDX_",","50*","I","MDCX")
22 .S MDCK="" F S MDCK=$O(MDCX(123.03,MDCK)) Q:MDCK<1 S MDX4=$G(MDCX(123.03,MDCK,.01,"I")) D
23 ..I MDX4["TIU" D
24 ...S MDFIL=8925,MDDTE=$$GET1^DIQ(MDFIL,+MDX4_",",1201,"I")
25 ...S Y=MDDTE X ^DD("DD") N MDREV S MDREV=(9999999.9999-MDDTE)
26 ...S:$G(^TMP("MDPLST",$J,MDREV,MDCPRO_"~"_+MDX4))="" ^(MDCPRO_"~"_+MDX4)=MDCPRO_"^"_+MDX4_"^"_"PRPRO"_"^"_"MDPS4"_"^^"_Y_"^^^^^"_MDCPRO_"^^"_+MDX_"^"_+MDX4,MDFIL=123
27 ...Q
28 ..Q
29 .Q
30 K ^TMP("GMRCR",$J,"CS")
31 Q
32PRPRO ; Return the Result Text for File Consult Procedure records
33 Q:'$G(MCARGDA)
34 N FFF,MDCK1,MDCLIN,MDCON,MDFIL,MDIMG,MDLCT,MDMCG,MDMED,MDNAME,MDREC,MDPRILV,MDPTR,MDSTUDY,MDTIM,MDTIU,MDTL,MDX4,PATID,MDRPG,RESULTS,MDXX,X
35 I '$G(MDALL) K ^TMP("MDPTXT",$J)
36 K ^TMP("MDTMPT",$J) D NOW^%DTC S X=% D DTIME^MCARP S MDTIM=$$FMTE^XLFDT(X,2) K %
37 S MDIMG=0,$P(FFF,"-",80)="",(MDLCT,MDRPG)=0,MDF=123
38 S MDSTUDY=+$G(MCARGDA)
39 S (MDPRILV,RESULTS)="",MDCLIN=0
40 D CANDO^TIUSRVA(.MDPRILV,+MDSTUDY,"VIEW")
41 I +MDPRILV D TGET^TIUSRVR1(.RESULTS,+MDSTUDY) M ^TMP("MDTMPT",$J,MCARGDA,MCPRO)=@RESULTS K ^TMP("TIUVIEW",$J) Q:+$G(MDALL)
42 S:+MDPRILV<1 ^TMP("MDTMPT",$J,MCARGDA,MCPRO,1)=$P(MDPRILV,U,2)
43 K ^TMP("MDTIUST",$J) N MDTIUER,MDTST S (MDNAME,MDTIUER,MDTST)=""
44 D EXTRACT^TIULQ(+MDSTUDY,"^TMP(""MDTIUST"",$J)",MDTIUER,".01;.02;1405","IE") Q:+MDTIUER
45 S MDTST=$G(^TMP("MDTIUST",$J,+MDSTUDY,1405,"I")),MDTST=$S(MDTST["GMR(123":+MDTST,1:0)
46 S MDNAME=$G(^TMP("MDTIUST",$J,+MDSTUDY,.02,"E")),MDRPG=MDRPG+1
47 S MDXX=$G(^TMP("MDTIUST",$J,+MDSTUDY,.01,"E"))
48 S MDFIL=123 S MDTL=$S(+MDTST:$$GET1^DIQ(MDFIL,+MDTST_",",4,"E"),1:MDXX)
49 I '$G(MDHDR) D
50 .S MDLCT=MDLCT+1,^TMP("MDPTXT",$J,MCARGDA,MCPRO,MDLCT)="Pg. "_MDRPG_$J(" ",25)_$$HOSP^MDPS2(DFN)_$J(" ",25)_MDTIM
51 .S MDLCT=MDLCT+1 S ^TMP("MDPTXT",$J,MCARGDA,MCPRO,MDLCT)=$J(" ",25)_MDTL
52 .S MDLCT=MDLCT+1 S ^TMP("MDPTXT",$J,MCARGDA,MCPRO,MDLCT)=$$DEMO^MDPS2(DFN)
53 .S MDLCT=MDLCT+1 S ^TMP("MDPTXT",$J,MCARGDA,MCPRO,MDLCT)=FFF
54 S MDCK1="" F S MDCK1=$O(^TMP("MDTMPT",$J,MCARGDA,MCPRO,MDCK1)) Q:MDCK1<1 S MDXX=$G(^(MDCK1)),MDLCT=MDLCT+1,^TMP("MDPTXT",$J,MCARGDA,MCPRO,MDLCT)=MDXX
55 K ^TMP("MDTMPT",$J,MCARGDA,MCPRO)
56NXT Q:+$G(MDALL) Q:+$G(MDRDV)
57 I $D(ORHFS) U IO G PRINT^MDPS1
58 G PRINT^MDPS1
Note: See TracBrowser for help on using the repository browser.