- 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 Mar 13, 2025@20:48:17 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
