source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDPOST6A.m@ 757

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1MDPOST6A ;HOIFO/NCA-Convert Existing Notes to New File ;11/28/07 14:31
2 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
3 ; Reference IA #2693 [Subscription] TIULQ call
4 ; 2916 [Supported] DDMOD calls
5EN1 ; Start Converting Notes
6 D P1
7 D P2
8 Q
9P1 ; Process multiple notes from Hemo.
10 Q:'$D(^MDD(702,"C"))
11 N MDCHK,MDCST,MDCTR,MDDL,MDFDA,MDK,MDSID,MDX1 S MDDL="",MDCTR=0
12 S MDSID=0 F S MDSID=$O(^MDD(702,"C",MDSID)) Q:MDSID<1 D
13 .S MDK=0 F S MDK=$O(^MDD(702,"C",MDSID,MDK)) Q:MDK<1 S MDX1=+MDK D
14 ..N MDTIUER
15 ..S MDTIUER="" K ^TMP("MDTIUST",$J)
16 ..D EXTRACT^TIULQ(+MDX1,"^TMP(""MDTIUST"",$J)",MDTIUER,".01;.05;1201;1202;1205") Q:+MDTIUER
17 ..I $G(^TMP("MDTIUST",$J,MDX1,.05,"E"))'="COMPLETED" Q
18 ..S MDCHK=$O(^MDD(702.001,"ASTUDY",+MDSID,+MDX1,0)) Q:+MDCHK
19 ..S MDFDA(702.001,"+1,",.01)=MDSID
20 ..S MDFDA(702.001,"+1,",.02)=+MDX1
21 ..S MDFDA(702.001,"+1,",.03)=$G(^TMP("MDTIUST",$J,MDX1,1201,"I"))
22 ..D UPDATE^DIE("","MDFDA")
23 ..S MDCTR=MDCTR+1
24 ..K ^TMP("MDTIUST",$J),MDFDA
25 ..Q
26 I MDCTR=+$P($G(^MDD(702.001,0)),"^",4) D DELIXN^DDMOD(702,"C") K ^MDD(702,"C")
27 Q
28P2 ; Move existing TIU Notes in CP Transaction File
29 N MDCHK,MDCST,MDCTR,MDDL,MDFDA,MDK,MDSID,MDX1 S MDDL="",MDCTR=0
30 Q:+$P($G(^MDD(702.001,0)),"^",4)>0
31 S MDK=0 F S MDK=$O(^MDD(702,"ATIU",MDK)) Q:MDK<1 D
32 .S MDSID=0 F S MDSID=$O(^MDD(702,"ATIU",MDK,MDSID)) Q:MDSID<1 S MDX1=+MDK D
33 ..N MDTIUER
34 ..S MDTIUER="" K ^TMP("MDTIUST",$J)
35 ..D EXTRACT^TIULQ(+MDX1,"^TMP(""MDTIUST"",$J)",MDTIUER,".01;.05;1201;1202;1205") Q:+MDTIUER
36 ..S MDCHK=$O(^MDD(702.001,"ASTUDY",+MDSID,+MDX1,0)) Q:+MDCHK
37 ..S MDFDA(702.001,"+1,",.01)=MDSID
38 ..S MDFDA(702.001,"+1,",.02)=+MDX1
39 ..S MDFDA(702.001,"+1,",.03)=$G(^TMP("MDTIUST",$J,MDX1,1201,"I"))
40 ..S MDCTR=MDCTR+1
41 ..D UPDATE^DIE("","MDFDA")
42 ..K ^TMP("MDTIUST",$J),MDFDA
43 ..Q
44 Q
Note: See TracBrowser for help on using the repository browser.