MDPOST6A ;HOIFO/NCA-Convert Existing Notes to New File ;11/28/07 14:31
;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
; Reference IA #2693 [Subscription] TIULQ call
; 2916 [Supported] DDMOD calls
EN1 ; Start Converting Notes
D P1
D P2
Q
P1 ; Process multiple notes from Hemo.
Q:'$D(^MDD(702,"C"))
N MDCHK,MDCST,MDCTR,MDDL,MDFDA,MDK,MDSID,MDX1 S MDDL="",MDCTR=0
S MDSID=0 F S MDSID=$O(^MDD(702,"C",MDSID)) Q:MDSID<1 D
.S MDK=0 F S MDK=$O(^MDD(702,"C",MDSID,MDK)) Q:MDK<1 S MDX1=+MDK D
..N MDTIUER
..S MDTIUER="" K ^TMP("MDTIUST",$J)
..D EXTRACT^TIULQ(+MDX1,"^TMP(""MDTIUST"",$J)",MDTIUER,".01;.05;1201;1202;1205") Q:+MDTIUER
..I $G(^TMP("MDTIUST",$J,MDX1,.05,"E"))'="COMPLETED" Q
..S MDCHK=$O(^MDD(702.001,"ASTUDY",+MDSID,+MDX1,0)) Q:+MDCHK
..S MDFDA(702.001,"+1,",.01)=MDSID
..S MDFDA(702.001,"+1,",.02)=+MDX1
..S MDFDA(702.001,"+1,",.03)=$G(^TMP("MDTIUST",$J,MDX1,1201,"I"))
..D UPDATE^DIE("","MDFDA")
..S MDCTR=MDCTR+1
..K ^TMP("MDTIUST",$J),MDFDA
..Q
I MDCTR=+$P($G(^MDD(702.001,0)),"^",4) D DELIXN^DDMOD(702,"C") K ^MDD(702,"C")
Q
P2 ; Move existing TIU Notes in CP Transaction File
N MDCHK,MDCST,MDCTR,MDDL,MDFDA,MDK,MDSID,MDX1 S MDDL="",MDCTR=0
Q:+$P($G(^MDD(702.001,0)),"^",4)>0
S MDK=0 F S MDK=$O(^MDD(702,"ATIU",MDK)) Q:MDK<1 D
.S MDSID=0 F S MDSID=$O(^MDD(702,"ATIU",MDK,MDSID)) Q:MDSID<1 S MDX1=+MDK D
..N MDTIUER
..S MDTIUER="" K ^TMP("MDTIUST",$J)
..D EXTRACT^TIULQ(+MDX1,"^TMP(""MDTIUST"",$J)",MDTIUER,".01;.05;1201;1202;1205") Q:+MDTIUER
..S MDCHK=$O(^MDD(702.001,"ASTUDY",+MDSID,+MDX1,0)) Q:+MDCHK
..S MDFDA(702.001,"+1,",.01)=MDSID
..S MDFDA(702.001,"+1,",.02)=+MDX1
..S MDFDA(702.001,"+1,",.03)=$G(^TMP("MDTIUST",$J,MDX1,1201,"I"))
..S MDCTR=MDCTR+1
..D UPDATE^DIE("","MDFDA")
..K ^TMP("MDTIUST",$J),MDFDA
..Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDPOST6A 1845 printed Dec 13, 2024@01:43:37 Page 2
MDPOST6A ;HOIFO/NCA-Convert Existing Notes to New File ;11/28/07 14:31
+1 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
+2 ; Reference IA #2693 [Subscription] TIULQ call
+3 ; 2916 [Supported] DDMOD calls
EN1 ; Start Converting Notes
+1 DO P1
+2 DO P2
+3 QUIT
P1 ; Process multiple notes from Hemo.
+1 if '$DATA(^MDD(702,"C"))
QUIT
+2 NEW MDCHK,MDCST,MDCTR,MDDL,MDFDA,MDK,MDSID,MDX1
SET MDDL=""
SET MDCTR=0
+3 SET MDSID=0
FOR
SET MDSID=$ORDER(^MDD(702,"C",MDSID))
if MDSID<1
QUIT
Begin DoDot:1
+4 SET MDK=0
FOR
SET MDK=$ORDER(^MDD(702,"C",MDSID,MDK))
if MDK<1
QUIT
SET MDX1=+MDK
Begin DoDot:2
+5 NEW MDTIUER
+6 SET MDTIUER=""
KILL ^TMP("MDTIUST",$JOB)
+7 DO EXTRACT^TIULQ(+MDX1,"^TMP(""MDTIUST"",$J)",MDTIUER,".01;.05;1201;1202;1205")
if +MDTIUER
QUIT
+8 IF $GET(^TMP("MDTIUST",$JOB,MDX1,.05,"E"))'="COMPLETED"
QUIT
+9 SET MDCHK=$ORDER(^MDD(702.001,"ASTUDY",+MDSID,+MDX1,0))
if +MDCHK
QUIT
+10 SET MDFDA(702.001,"+1,",.01)=MDSID
+11 SET MDFDA(702.001,"+1,",.02)=+MDX1
+12 SET MDFDA(702.001,"+1,",.03)=$GET(^TMP("MDTIUST",$JOB,MDX1,1201,"I"))
+13 DO UPDATE^DIE("","MDFDA")
+14 SET MDCTR=MDCTR+1
+15 KILL ^TMP("MDTIUST",$JOB),MDFDA
+16 QUIT
End DoDot:2
End DoDot:1
+17 IF MDCTR=+$PIECE($GET(^MDD(702.001,0)),"^",4)
DO DELIXN^DDMOD(702,"C")
KILL ^MDD(702,"C")
+18 QUIT
P2 ; Move existing TIU Notes in CP Transaction File
+1 NEW MDCHK,MDCST,MDCTR,MDDL,MDFDA,MDK,MDSID,MDX1
SET MDDL=""
SET MDCTR=0
+2 if +$PIECE($GET(^MDD(702.001,0)),"^",4)>0
QUIT
+3 SET MDK=0
FOR
SET MDK=$ORDER(^MDD(702,"ATIU",MDK))
if MDK<1
QUIT
Begin DoDot:1
+4 SET MDSID=0
FOR
SET MDSID=$ORDER(^MDD(702,"ATIU",MDK,MDSID))
if MDSID<1
QUIT
SET MDX1=+MDK
Begin DoDot:2
+5 NEW MDTIUER
+6 SET MDTIUER=""
KILL ^TMP("MDTIUST",$JOB)
+7 DO EXTRACT^TIULQ(+MDX1,"^TMP(""MDTIUST"",$J)",MDTIUER,".01;.05;1201;1202;1205")
if +MDTIUER
QUIT
+8 SET MDCHK=$ORDER(^MDD(702.001,"ASTUDY",+MDSID,+MDX1,0))
if +MDCHK
QUIT
+9 SET MDFDA(702.001,"+1,",.01)=MDSID
+10 SET MDFDA(702.001,"+1,",.02)=+MDX1
+11 SET MDFDA(702.001,"+1,",.03)=$GET(^TMP("MDTIUST",$JOB,MDX1,1201,"I"))
+12 SET MDCTR=MDCTR+1
+13 DO UPDATE^DIE("","MDFDA")
+14 KILL ^TMP("MDTIUST",$JOB),MDFDA
+15 QUIT
End DoDot:2
End DoDot:1
+16 QUIT
