Routine: MDRPCW1

MDRPCW1 ; HOIFO/NCA - MD TMDENCOUNTER Object ;2/16/10  16:17

 ;;1.0;CLINICAL PROCEDURES;**6,21,20,29**;Apr 01, 2004;Build 22

 ; Reference Integration Agreement:

 ; IA #1573 [Supported] ICDONE^LEXU call

 ; IA #1593 [Subscription] Access to Provider Narrative file

 ;                         (#9999999.27)

 ; IA #1609 [Supported] CONFIG^LEXSET call

 ; IA #1894 [Subscription] PXAPI calls

 ; IA #1995 [Supported] ICPTCOD calls

 ; IA #2056 [Supported] Call to DIQ

 ; IA #2263 [Supported] XPAR calls

 ; IA #2348 [Subscription] SCCOND^PXUTLSCC call

 ; IA #2950 [Supported] LOOK^LEXA call

 ; IA #5699 [Supported] ICDDATA^ICDXCODE calls

 ; IA #10060 [Supported] FILE 200 references

 ; IA #5747 [Supported] $$SINFO^ICDEX

CPTMODS(RESULTS,MDCPT) ;Return CPT Modifiers for a CPT Code

 N MDARR,MDIDX,MDI,MDNAME

 S RESULTS=$NA(^TMP("MDMODS",$J)) K @RESULTS

 S MDDATE=DT

 I +($$CODM^ICPTCOD(MDCPT,$NA(MDARR),0,MDDATE)),+$D(MDARR) D

 . S MDIDX="",MDI=0

 . F  S MDIDX=$O(MDARR(MDIDX)) Q:(MDIDX="")  D

 . . S MDI=MDI+1,MDNAME=$P(MDARR(MDIDX),U,1)

 . . S @RESULTS@(MDNAME_MDI)=$P(MDARR(MDIDX),U,2)_U_MDNAME_U_MDIDX

LEX(RESULTS,MDSRCH,MDAPP,STUDY)   ; return list after lexicon lookup

 N CODE,LEX,MDLST,MDI,LEXIEN,MDVAL

 S RESULTS=$NA(^TMP("MDLEX",$J)) K @RESULTS

 Q:'$G(STUDY)

 Q:'$G(^MDD(702,+STUDY,0))

 S MDDATE=$P($P($P(^MDD(702,STUDY,0),"^",7),";",2),".",1)

 S:MDAPP="CPT" MDAPP="CHP" ; LEX PATCH 10

 K ^TMP("LEXSCH",$J)

 I MDAPP="ICD" S MDAPP=$P($$SINFO^ICDEX("DIAG",MDDATE),"^",3)

 D CONFIG^LEXSET(MDAPP,MDAPP,MDDATE)

 D LOOK^LEXA(MDSRCH,MDAPP,1,"",MDDATE)

 I '$D(LEX("LIST",1)) S @RESULTS@(1)="-1^No matches found." Q

 S @RESULTS@(1)=LEX("LIST",1),MDLST=1

 S MDI="" F  S MDI=$O(^TMP("LEXFND",$J,MDI)) Q:MDI'<0  D

 . S LEXIEN=$O(^TMP("LEXFND",$J,MDI,0))

 . S MDLST=MDLST+1,@RESULTS@(MDLST)=LEXIEN_U_^TMP("LEXFND",$J,MDI,LEXIEN)

 K ^TMP("LEXFND",$J),^TMP("LEXHIT",$J)

 S MDI="" F  S MDI=$O(@RESULTS@(MDI)) Q:'MDI  S MDVAL=$G(@RESULTS@(MDI)) D

 . I MDAPP="ICD"!(MDAPP="10D") S CODE=$$ONE^LEXU(+MDVAL,MDDATE,MDAPP),@RESULTS@(MDI)=CODE_U_MDVAL

 . I MDAPP="CPT"!(MDAPP="CHP") S CODE=$$CPTONE^LEXU(+MDVAL,MDDATE),@RESULTS@(MDI)=CODE_U_MDVAL

 . I CODE="",(MDAPP="CHP") S CODE=$$CPCONE^LEXU(+MDVAL,MDDATE),@RESULTS@(MDI)=CODE_U_MDVAL

GETENC(RESULTS,STUDY) ; Return the current encounter data entered

 S RESULTS=$NA(^TMP("MDENC",$J)) K @RESULTS

 N MDDAR,MDDAR2,CAT,CODE,DIAG,GLOARR,MDCCON,MDX802,MDARR,MDCPT,MDCTR,MDDFN,MDENCDT,MDFLST,MDICD,MDLC,MDLL,MDLOCN,MDPROV,MDRP,MDRST,MDVST,MDVSTR,QTY,MDX,MDX0,MDX1,S S S=";"

 N GDIAG,LLB,MDDDN,MDDDV,MDCK,RESLT,MDNCTR,MDPFLG,MDCLL,MDDESC S (MDCK,MDPFLG)=0

 Q:'$G(STUDY)

 Q:'$G(^MDD(702,+STUDY,0))

 D NOW^%DTC S MDDEF=% K % S MDCTR=0

 K ^TMP("MDDAR",$J),^TMP("MDLEX",$J),GLOARR,MDFLST

 S MDX=$G(^MDD(702,+STUDY,0)),MDX1=$G(^(1)),MDCCON=$P(MDX,U,5)

 S MDVST=$P(MDX1,U),MDDFN=$P(MDX,U) Q:'MDDFN

 S:+MDVST MDPFLG=1

 S MDVSTR=$P(MDX,U,7),MDDAR=$NA(^TMP("MDDAR",$J)),MDDAR2=$NA(GLOARR),@MDDAR2@("POV",0)=0,@MDDAR2@("CPT",0)=0,MDLC=0

 I 'MDVST S MDRP=0 F  S MDRP=$O(^MDD(702,STUDY,.1,MDRP)) Q:'MDRP  D

 .S MDRST=$P($G(^MDD(702,STUDY,.1,+MDRP,0)),"^",3)

 .I +MDRST D CICNV^MDHL7U3(+MDRST,.MDDAR) D SETGLO(.MDDAR,.MDDAR2)

 .K ^TMP("MDDAR",$J) Q

 I 'MDVST&(+$G(@MDDAR2@("POV",0))>0) F MDLL=1:1:+$G(@MDDAR2@("POV",0)) S MDLC=MDLC+1,MDFLST(MDLC)=$G(@MDDAR2@("POV",MDLL))

 I 'MDVST&(+$G(@MDDAR2@("CPT",0))>0) F MDLL=1:1:+$G(@MDDAR2@("CPT",0)) S MDLC=MDLC+1,MDFLST(MDLC)=$G(@MDDAR2@("CPT",MDLL))

 I MDVST>0 S MDENCDT=$P(MDVSTR,";",2),MDLOCN=$P(MDVSTR,";",3)

 ;E  S MDENCDT=$$PDT^MDRPCOT1(STUDY)

 E  S MDENCDT=$P(MDVSTR,";",2)

 S:$L(MDVSTR,";")=1 MDVSTR=";"_MDVSTR

 S MDVSTR=$$GETVSTR^MDRPCOT1(MDDFN,MDVSTR,+$P(MDX,U,4),$P(MDX,U,2)),MDLOCN=$P(MDVSTR,";",1)

 S:'MDENCDT MDENCDT=$P(MDVSTR,";",2)

 S:'MDENCDT MDENCDT=MDDEF

 S:'MDLOCN MDLOCN=$P(MDVSTR,";")

 D SCCOND^PXUTLSCC(MDDFN,MDENCDT,MDLOCN,MDVST,.MDARR)

 S MDCTR=MDCTR+1

 ; ^TMP("MDENC",$J,n)="SC";0/1^0/1;"AO";0/1^0/1;"IR";0/1^0/1;"EC";0/1^0/1;"MST";0/1^0/1;"HNC";0/1^0/1;"CV";0/1^0/1

 ;first piece 1 if the condition can be answered

 ;            0 if the condition should be null not asked

 ;second piece - If Scheduling has the answer, 1 = yes 0 = no

 S @RESULTS@(MDCTR)="SC"_S_$G(MDARR("SC"))_S_"AO"_S_$G(MDARR("AO"))_S_"IR"_S_$G(MDARR("IR"))_S_"EC"_S_$G(MDARR("EC"))_S_"MST"_S_$G(MDARR("MST"))_S_"HNC"_S_$G(MDARR("HNC"))_S_"CV"_S_$G(MDARR("CV"))

 I 'MDVST S MDVST=$$GETENC^PXAPI(MDDFN,MDENCDT,MDLOCN),MDVST=$S(+MDVST<1:0,1:+MDVST)

 I +MDVST>0 D ENCEVENT^PXAPI(MDVST)

 ;^TMP("MDENC",$J,n)="PRV"^CODE^^NARR^^Primary (1=Yes,0=No)

 I +MDVST>0 S MDPROV=0 F  S MDPROV=$O(^TMP("PXKENC",$J,MDVST,"PRV",MDPROV)) Q:'MDPROV  D

 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"PRV",MDPROV,0))

 .S CODE=+$P(MDX0,U)

 .I +CODE S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="PRV"_U_CODE_U_U_$$GET1^DIQ(200,+CODE_",",.01,"E")_U_U_($P(MDX0,U,4)="P")

 ;^TMP("MDENC",$J,n)="POV"^ICD9 IEN^ICD9 CODE^provider narrative category^provider narrative (Short Description)^Primary (1=Yes,0=No)

 I +MDVST>0 S MDICD=0 F  S MDICD=$O(^TMP("PXKENC",$J,MDVST,"POV",MDICD)) Q:'MDICD  D

 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"POV",MDICD,0)),MDX802=$G(^(802))

 .S CODE=+$G(MDX0,U),GDIAG=$$ICDDATA^ICDXCODE(80,CODE,MDENCDT)

 .S:CODE DIAG=$P(GDIAG,U,2)_U_$P(GDIAG,U,4)

 .S CAT=$P(MDX802,U)

 .S:CAT CAT=$P($G(^AUTNPOV(CAT,0)),U)

 .S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="POV"_U_+$G(MDX0,U)_U_$P(DIAG,U)_U_CAT_U_$P(DIAG,U,2)_U_($P(MDX0,U,12)="P"),MDCK=MDCK+1

 ;^TMP("MDENC",$J,n)="CPT"^CPT IEN^CPT CODE^provider narrative category^provider narrative (Description)^^Quantity

 I +MDVST>0 S MDCPT=0 F  S MDCPT=$O(^TMP("PXKENC",$J,MDVST,"CPT",MDCPT)) Q:'MDCPT  D

 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"CPT",MDCPT,0)),MDX802=$G(^(802))

 .S CODE=+$G(MDX0,U)

 .S:CODE CODE=$$CPT^ICPTCOD(CODE,MDVST)

 .S:CODE DIAG=$P(CODE,U,2,3)

 .S CAT=$P(MDX802,U)

 .S:CAT CAT=$P($G(^AUTNPOV(CAT,0)),U)

 .S QTY=$P(MDX0,U,16)

 .S MDDESC="" D CPTLEX^MDRPCWU(.RESLT,$P(DIAG,U),"CPT")

 .S MDCLL="" F  S MDCLL=$O(^TMP("MDLEX",$J,MDCLL)) Q:MDCLL<1  S MDDESC=$P(^(MDCLL),"^",3)

 .S:$L(MDDESC)>230 MDDESC=$E(MDDESC,1,230) K ^TMP("MDLEX",$J),RESLT

 .S:MDDESC="" MDDESC=$P(DIAG,U,2)

 .S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="CPT"_U_+$G(MDX0,U)_U_$P(DIAG,U)_U_CAT_U_MDDESC_U_U_QTY,MDCK=MDCK+1

 K ^TMP("PXKENC",$J)

 I 'MDVST!(+MDCK<1) D

 .S MDDDN=$O(^MDD(702,"ACON",MDCCON,+STUDY),-1),MDVST=0

 .I MDDDN D

 ..S MDDDV=$P($G(^MDD(702,+MDDDN,0)),U,7)

 ..S:$L(MDDDV,";")>1 MDENCDT=$P(MDDDV,";",2),MDVST=+$G(^MDD(702,+MDDDN,1)),MDVST=$S(+MDVST<1:0,1:+MDVST)

 ..I +MDVST>0 S MDNCTR=MDCTR F LLB=2:1:MDCTR K @RESULTS@(MDCTR) S MDNCTR=MDNCTR-1

 I $G(MDFLST(1))'="" S MDLL=0 F  S MDLL=$O(MDFLST(MDLL)) Q:MDLL<1  S:$G(MDFLST(MDLL))'="" MDCTR=MDCTR+1,@RESULTS@(MDCTR)=$G(MDFLST(MDLL))

 Q:MDCK>0

 Q:'MDVST

 D ENCEVENT^PXAPI(MDVST) S:$G(MDNCTR)>0 MDCTR=MDNCTR

 ;^TMP("MDENC",$J,n)="PRV"^CODE^^NARR^^Primary (1=Yes,0=No)

 S MDPROV=0 F  S MDPROV=$O(^TMP("PXKENC",$J,MDVST,"PRV",MDPROV)) Q:'MDPROV  D

.Q

 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"PRV",MDPROV,0))

 .S CODE=+$P(MDX0,U)

 .I +CODE S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="PRV"_U_CODE_U_U_$$GET1^DIQ(200,+CODE_",",.01,"E")_U_U_($P(MDX0,U,4)="P")

 ;^TMP("MDENC",$J,n)="POV"^ICD9 IEN^ICD9 CODE^provider narrative category^provider narrative (Short Description)^Primary (1=Yes,0=No)

 S MDICD=0 F  S MDICD=$O(^TMP("PXKENC",$J,MDVST,"POV",MDICD)) Q:'MDICD  D

 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"POV",MDICD,0)),MDX802=$G(^(802))

 .S CODE=+$G(MDX0,U),GDIAG=$$ICDDATA^ICDXCODE(80,CODE,MDENCDT)

 .S:CODE DIAG=$P(GDIAG,U,2)_U_$P(GDIAG,U,4)

 .S CAT=$P(MDX802,U)

 .S:CAT CAT=$P($G(^AUTNPOV(CAT,0)),U)

 .S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="POV"_U_+$G(MDX0,U)_U_$P(DIAG,U)_U_CAT_U_$P(DIAG,U,2)_U_($P(MDX0,U,12)="P")

 ;^TMP("MDENC",$J,n)="CPT"^CPT IEN^CPT CODE^provider narrative category^provider narrative (Short Description)^^Quantity

 S MDCPT=0 F  S MDCPT=$O(^TMP("PXKENC",$J,MDVST,"CPT",MDCPT)) Q:'MDCPT  D

 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"CPT",MDCPT,0)),MDX802=$G(^(802))

 .S CODE=+$G(MDX0,U)

 .S:CODE CODE=$$CPT^ICPTCOD(CODE,MDVST)

 .S:CODE DIAG=$P(CODE,U,2,3)

 .S CAT=$P(MDX802,U)

 .S:CAT CAT=$P($G(^AUTNPOV(CAT,0)),U)

 .S QTY=$P(MDX0,U,16)

 .S MDDESC="" D CPTLEX^MDRPCWU(.RESLT,$P(DIAG,U),"CPT")

 .S MDCLL="" F  S MDCLL=$O(^TMP("MDLEX",$J,MDCLL)) Q:MDCLL<1  S MDDESC=$P(^(MDCLL),"^",3)

 .S:$L(MDDESC)>230 MDDESC=$E(MDDESC,1,230) K ^TMP("MDLEX",$J),RESLT

 .S:MDDESC="" MDDESC=$P(DIAG,U,2)

 .S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="CPT"_U_+$G(MDX0,U)_U_$P(DIAG,U)_U_CAT_U_MDDESC_U_U_QTY

 K ^TMP("PXKENC",$J)

SETGLO(MDGLO1,MDGLO2) ; Set the ICD and CPT from device into a global array

 N MDA,MDB,MDC

 I +$G(@MDGLO1@(1))<1&(+$G(@MDGLO1@(2))<1) Q

 S MDA=$O(@MDGLO2@("POV",""),-1)

 S MDB=$O(@MDGLO2@("CPT",""),-1)

 F MDC=1:1:+$G(@MDGLO1@(1)) S MDA=MDA+1,@MDGLO2@("POV",MDA)=$G(@MDGLO1@(1,MDC))

 F MDC=1:1:+$G(@MDGLO1@(2)) S MDB=MDB+1,@MDGLO2@("CPT",MDB)=$G(@MDGLO1@(2,MDC))

 S @MDGLO2@("POV",0)=MDA,@MDGLO2@("CPT",0)=MDB

NTIU(P1,RECID) ; Create New TIU note for Result

 I $G(^MDD(702,+P1,0))="" Q 0

 N MDNEWN,MDFG,MDHVL,MDKK S MDFG=0

 D GETLST^XPAR(.MDHVL,"SYS","MD GET HIGH VOLUME")

 F MDKK=0:0 S MDKK=$O(MDHVL(MDKK)) Q:MDKK<1  I $P($G(MDHVL(MDKK)),"^")=+$P(^MDD(702,+P1,0),U,4) S MDFG=1 Q

 I $P($G(^MDS(702.01,+$P(^MDD(702,+P1,0),U,4),0)),U,6)=2 S MDNEWN=$$NEWTIUN^MDRPCOT2(+P1)

 I +$P($G(^MDS(702.01,+$P(^MDD(702,+P1,0),U,4),0)),U,10)!(+MDFG) S MDNEWN=$$NEWTIUN^MDRPCOTH(+P1,RECID)

Q 1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDRPCW1   9432     printed  Feb 18, 2025@23:10:41                                                                                                                                                                                                     Page 2

MDRPCW1   ; HOIFO/NCA - MD TMDENCOUNTER Object ;2/16/10  16:17

 +1       ;;1.0;CLINICAL PROCEDURES;**6,21,20,29**;Apr 01, 2004;Build 22

 +2       ; Reference Integration Agreement:

 +3       ; IA #1573 [Supported] ICDONE^LEXU call

 +4       ; IA #1593 [Subscription] Access to Provider Narrative file

 +5       ;                         (#9999999.27)

 +6       ; IA #1609 [Supported] CONFIG^LEXSET call

 +7       ; IA #1894 [Subscription] PXAPI calls

 +8       ; IA #1995 [Supported] ICPTCOD calls

 +9       ; IA #2056 [Supported] Call to DIQ

 +10      ; IA #2263 [Supported] XPAR calls

 +11      ; IA #2348 [Subscription] SCCOND^PXUTLSCC call

 +12      ; IA #2950 [Supported] LOOK^LEXA call

 +13      ; IA #5699 [Supported] ICDDATA^ICDXCODE calls

 +14      ; IA #10060 [Supported] FILE 200 references

 +15      ; IA #5747 [Supported] $$SINFO^ICDEX

 +16      ;

CPTMODS(RESULTS,MDCPT) ;Return CPT Modifiers for a CPT Code

 +1        NEW MDARR,MDIDX,MDI,MDNAME

 +2        SET RESULTS=$NAME(^TMP("MDMODS",$JOB))

           KILL @RESULTS

 +3        SET MDDATE=DT

 +4        IF +($$CODM^ICPTCOD(MDCPT,$NAME(MDARR),0,MDDATE))

               IF +$DATA(MDARR)

                   Begin DoDot:1

 +5                    SET MDIDX=""

                       SET MDI=0

 +6                    FOR

                           SET MDIDX=$ORDER(MDARR(MDIDX))

                           if (MDIDX="")

                               QUIT

                           Begin DoDot:2

 +7                            SET MDI=MDI+1

                               SET MDNAME=$PIECE(MDARR(MDIDX),U,1)

 +8                            SET @RESULTS@(MDNAME_MDI)=$PIECE(MDARR(MDIDX),U,2)_U_MDNAME_U_MDIDX

                           End DoDot:2

                   End DoDot:1

 +9        QUIT

LEX(RESULTS,MDSRCH,MDAPP,STUDY) ; return list after lexicon lookup

 +1        NEW CODE,LEX,MDLST,MDI,LEXIEN,MDVAL

 +2        SET RESULTS=$NAME(^TMP("MDLEX",$JOB))

           KILL @RESULTS

 +3        if '$GET(STUDY)

               QUIT

 +4        if '$GET(^MDD(702,+STUDY,0))

               QUIT

 +5        SET MDDATE=$PIECE($PIECE($PIECE(^MDD(702,STUDY,0),"^",7),";",2),".",1)

 +6       ; LEX PATCH 10

           if MDAPP="CPT"

               SET MDAPP="CHP"

 +7        KILL ^TMP("LEXSCH",$JOB)

 +8        IF MDAPP="ICD"

               SET MDAPP=$PIECE($$SINFO^ICDEX("DIAG",MDDATE),"^",3)

 +9        DO CONFIG^LEXSET(MDAPP,MDAPP,MDDATE)

 +10       DO LOOK^LEXA(MDSRCH,MDAPP,1,"",MDDATE)

 +11       IF '$DATA(LEX("LIST",1))

               SET @RESULTS@(1)="-1^No matches found."

               QUIT

 +12       SET @RESULTS@(1)=LEX("LIST",1)

           SET MDLST=1

 +13       SET MDI=""

FOR

               SET MDI=$ORDER(^TMP("LEXFND",$JOB,MDI))

               if MDI'<0

                   QUIT

               Begin DoDot:1

 +14               SET LEXIEN=$ORDER(^TMP("LEXFND",$JOB,MDI,0))

 +15               SET MDLST=MDLST+1

                   SET @RESULTS@(MDLST)=LEXIEN_U_^TMP("LEXFND",$JOB,MDI,LEXIEN)

               End DoDot:1

 +16       KILL ^TMP("LEXFND",$JOB),^TMP("LEXHIT",$JOB)

 +17       SET MDI=""

FOR

               SET MDI=$ORDER(@RESULTS@(MDI))

               if 'MDI

                   QUIT

               SET MDVAL=$GET(@RESULTS@(MDI))

               Begin DoDot:1

 +18               IF MDAPP="ICD"!(MDAPP="10D")

                       SET CODE=$$ONE^LEXU(+MDVAL,MDDATE,MDAPP)

                       SET @RESULTS@(MDI)=CODE_U_MDVAL

 +19               IF MDAPP="CPT"!(MDAPP="CHP")

                       SET CODE=$$CPTONE^LEXU(+MDVAL,MDDATE)

                       SET @RESULTS@(MDI)=CODE_U_MDVAL

 +20               IF CODE=""

                       IF (MDAPP="CHP")

                           SET CODE=$$CPCONE^LEXU(+MDVAL,MDDATE)

                           SET @RESULTS@(MDI)=CODE_U_MDVAL

               End DoDot:1

 +21       QUIT

GETENC(RESULTS,STUDY) ; Return the current encounter data entered

 +1        SET RESULTS=$NAME(^TMP("MDENC",$JOB))

           KILL @RESULTS

 +2        NEW MDDAR,MDDAR2,CAT,CODE,DIAG,GLOARR,MDCCON,MDX802,MDARR,MDCPT,MDCTR,MDDFN,MDENCDT,MDFLST,MDICD,MDLC,MDLL,MDLOCN,MDPROV,MDRP,MDRST,MDVST,MDVSTR,QTY,MDX,MDX0,MDX1,S

           SET S=";"

 +3        NEW GDIAG,LLB,MDDDN,MDDDV,MDCK,RESLT,MDNCTR,MDPFLG,MDCLL,MDDESC

           SET (MDCK,MDPFLG)=0

 +4        if '$GET(STUDY)

               QUIT

 +5        if '$GET(^MDD(702,+STUDY,0))

               QUIT

 +6        DO NOW^%DTC

           SET MDDEF=%

           KILL %

           SET MDCTR=0

 +7        KILL ^TMP("MDDAR",$JOB),^TMP("MDLEX",$JOB),GLOARR,MDFLST

 +8        SET MDX=$GET(^MDD(702,+STUDY,0))

           SET MDX1=$GET(^(1))

           SET MDCCON=$PIECE(MDX,U,5)

 +9        SET MDVST=$PIECE(MDX1,U)

           SET MDDFN=$PIECE(MDX,U)

           if 'MDDFN

               QUIT

 +10       if +MDVST

               SET MDPFLG=1

 +11       SET MDVSTR=$PIECE(MDX,U,7)

           SET MDDAR=$NAME(^TMP("MDDAR",$JOB))

           SET MDDAR2=$NAME(GLOARR)

           SET @MDDAR2@("POV",0)=0

           SET @MDDAR2@("CPT",0)=0

           SET MDLC=0

 +12       IF 'MDVST

               SET MDRP=0

FOR

                   SET MDRP=$ORDER(^MDD(702,STUDY,.1,MDRP))

                   if 'MDRP

                       QUIT

                   Begin DoDot:1

 +13                   SET MDRST=$PIECE($GET(^MDD(702,STUDY,.1,+MDRP,0)),"^",3)

 +14                   IF +MDRST

                           DO CICNV^MDHL7U3(+MDRST,.MDDAR)

                           DO SETGLO(.MDDAR,.MDDAR2)

 +15                   KILL ^TMP("MDDAR",$JOB)

                       QUIT

                   End DoDot:1

 +16       IF 'MDVST&(+$GET(@MDDAR2@("POV",0))>0)

               FOR MDLL=1:1:+$GET(@MDDAR2@("POV",0))

                   SET MDLC=MDLC+1

                   SET MDFLST(MDLC)=$GET(@MDDAR2@("POV",MDLL))

 +17       IF 'MDVST&(+$GET(@MDDAR2@("CPT",0))>0)

               FOR MDLL=1:1:+$GET(@MDDAR2@("CPT",0))

                   SET MDLC=MDLC+1

                   SET MDFLST(MDLC)=$GET(@MDDAR2@("CPT",MDLL))

 +18       IF MDVST>0

               SET MDENCDT=$PIECE(MDVSTR,";",2)

               SET MDLOCN=$PIECE(MDVSTR,";",3)

 +19      ;E  S MDENCDT=$$PDT^MDRPCOT1(STUDY)

 +20      IF '$TEST

               SET MDENCDT=$PIECE(MDVSTR,";",2)

 +21       if $LENGTH(MDVSTR,";")=1

               SET MDVSTR=";"_MDVSTR

 +22       SET MDVSTR=$$GETVSTR^MDRPCOT1(MDDFN,MDVSTR,+$PIECE(MDX,U,4),$PIECE(MDX,U,2))

           SET MDLOCN=$PIECE(MDVSTR,";",1)

 +23       if 'MDENCDT

               SET MDENCDT=$PIECE(MDVSTR,";",2)

 +24       if 'MDENCDT

               SET MDENCDT=MDDEF

 +25       if 'MDLOCN

               SET MDLOCN=$PIECE(MDVSTR,";")

 +26       DO SCCOND^PXUTLSCC(MDDFN,MDENCDT,MDLOCN,MDVST,.MDARR)

 +27       SET MDCTR=MDCTR+1

 +28      ; ^TMP("MDENC",$J,n)="SC";0/1^0/1;"AO";0/1^0/1;"IR";0/1^0/1;"EC";0/1^0/1;"MST";0/1^0/1;"HNC";0/1^0/1;"CV";0/1^0/1

 +29      ;first piece 1 if the condition can be answered

 +30      ;            0 if the condition should be null not asked

 +31      ;second piece - If Scheduling has the answer, 1 = yes 0 = no

 +32       SET @RESULTS@(MDCTR)="SC"_S_$GET(MDARR("SC"))_S_"AO"_S_$GET(MDARR("AO"))_S_"IR"_S_$GET(MDARR("IR"))_S_"EC"_S_$GET(MDARR("EC"))_S_"MST"_S_$GET(MDARR("MST"))_S_"HNC"_S_$GET(MDARR("HNC"))_S_"CV"_S_$GET(MDARR("CV"))

 +33       IF 'MDVST

               SET MDVST=$$GETENC^PXAPI(MDDFN,MDENCDT,MDLOCN)

               SET MDVST=$SELECT(+MDVST<1:0,1:+MDVST)

 +34       IF +MDVST>0

               DO ENCEVENT^PXAPI(MDVST)

 +35      ;^TMP("MDENC",$J,n)="PRV"^CODE^^NARR^^Primary (1=Yes,0=No)

 +36       IF +MDVST>0

               SET MDPROV=0

FOR

                   SET MDPROV=$ORDER(^TMP("PXKENC",$JOB,MDVST,"PRV",MDPROV))

                   if 'MDPROV

                       QUIT

                   Begin DoDot:1

 +37                   SET MDX0=$GET(^TMP("PXKENC",$JOB,MDVST,"PRV",MDPROV,0))

 +38                   SET CODE=+$PIECE(MDX0,U)

 +39                   IF +CODE

                           SET MDCTR=MDCTR+1

                           SET @RESULTS@(MDCTR)="PRV"_U_CODE_U_U_$$GET1^DIQ(200,+CODE_",",.01,"E")_U_U_($PIECE(MDX0,U,4)="P")

                   End DoDot:1

 +40      ;^TMP("MDENC",$J,n)="POV"^ICD9 IEN^ICD9 CODE^provider narrative category^provider narrative (Short Description)^Primary (1=Yes,0=No)

 +41       IF +MDVST>0

               SET MDICD=0

FOR

                   SET MDICD=$ORDER(^TMP("PXKENC",$JOB,MDVST,"POV",MDICD))

                   if 'MDICD

                       QUIT

                   Begin DoDot:1

 +42                   SET MDX0=$GET(^TMP("PXKENC",$JOB,MDVST,"POV",MDICD,0))

                       SET MDX802=$GET(^(802))

 +43                   SET CODE=+$GET(MDX0,U)

                       SET GDIAG=$$ICDDATA^ICDXCODE(80,CODE,MDENCDT)

 +44                   if CODE

                           SET DIAG=$PIECE(GDIAG,U,2)_U_$PIECE(GDIAG,U,4)

 +45                   SET CAT=$PIECE(MDX802,U)

 +46                   if CAT

                           SET CAT=$PIECE($GET(^AUTNPOV(CAT,0)),U)

 +47                   SET MDCTR=MDCTR+1

                       SET @RESULTS@(MDCTR)="POV"_U_+$GET(MDX0,U)_U_$PIECE(DIAG,U)_U_CAT_U_$PIECE(DIAG,U,2)_U_($PIECE(MDX0,U,12)="P")

                       SET MDCK=MDCK+1

                   End DoDot:1

 +48      ;^TMP("MDENC",$J,n)="CPT"^CPT IEN^CPT CODE^provider narrative category^provider narrative (Description)^^Quantity

 +49       IF +MDVST>0

               SET MDCPT=0

FOR

                   SET MDCPT=$ORDER(^TMP("PXKENC",$JOB,MDVST,"CPT",MDCPT))

                   if 'MDCPT

                       QUIT

                   Begin DoDot:1

 +50                   SET MDX0=$GET(^TMP("PXKENC",$JOB,MDVST,"CPT",MDCPT,0))

                       SET MDX802=$GET(^(802))

 +51                   SET CODE=+$GET(MDX0,U)

 +52                   if CODE

                           SET CODE=$$CPT^ICPTCOD(CODE,MDVST)

 +53                   if CODE

                           SET DIAG=$PIECE(CODE,U,2,3)

 +54                   SET CAT=$PIECE(MDX802,U)

 +55                   if CAT

                           SET CAT=$PIECE($GET(^AUTNPOV(CAT,0)),U)

 +56                   SET QTY=$PIECE(MDX0,U,16)

 +57                   SET MDDESC=""

                       DO CPTLEX^MDRPCWU(.RESLT,$PIECE(DIAG,U),"CPT")

 +58                   SET MDCLL=""

FOR

                           SET MDCLL=$ORDER(^TMP("MDLEX",$JOB,MDCLL))

                           if MDCLL<1

                               QUIT

                           SET MDDESC=$PIECE(^(MDCLL),"^",3)

 +59                   if $LENGTH(MDDESC)>230

                           SET MDDESC=$EXTRACT(MDDESC,1,230)

                       KILL ^TMP("MDLEX",$JOB),RESLT

 +60                   if MDDESC=""

                           SET MDDESC=$PIECE(DIAG,U,2)

 +61                   SET MDCTR=MDCTR+1

                       SET @RESULTS@(MDCTR)="CPT"_U_+$GET(MDX0,U)_U_$PIECE(DIAG,U)_U_CAT_U_MDDESC_U_U_QTY

                       SET MDCK=MDCK+1

                   End DoDot:1

 +62       KILL ^TMP("PXKENC",$JOB)

 +63       IF 'MDVST!(+MDCK<1)

               Begin DoDot:1

 +64               SET MDDDN=$ORDER(^MDD(702,"ACON",MDCCON,+STUDY),-1)

                   SET MDVST=0

 +65               IF MDDDN

                       Begin DoDot:2

 +66                       SET MDDDV=$PIECE($GET(^MDD(702,+MDDDN,0)),U,7)

 +67                       if $LENGTH(MDDDV,";")>1

                               SET MDENCDT=$PIECE(MDDDV,";",2)

                               SET MDVST=+$GET(^MDD(702,+MDDDN,1))

                               SET MDVST=$SELECT(+MDVST<1:0,1:+MDVST)

 +68                       IF +MDVST>0

                               SET MDNCTR=MDCTR

                               FOR LLB=2:1:MDCTR

                                   KILL @RESULTS@(MDCTR)

                                   SET MDNCTR=MDNCTR-1

                       End DoDot:2

               End DoDot:1

 +69       IF $GET(MDFLST(1))'=""

               SET MDLL=0

FOR

                   SET MDLL=$ORDER(MDFLST(MDLL))

                   if MDLL<1

                       QUIT

                   if $GET(MDFLST(MDLL))'=""

                       SET MDCTR=MDCTR+1

                       SET @RESULTS@(MDCTR)=$GET(MDFLST(MDLL))

 +70       if MDCK>0

               QUIT

 +71       if 'MDVST

               QUIT

 +72       DO ENCEVENT^PXAPI(MDVST)

           if $GET(MDNCTR)>0

               SET MDCTR=MDNCTR

 +73      ;^TMP("MDENC",$J,n)="PRV"^CODE^^NARR^^Primary (1=Yes,0=No)

 +74       SET MDPROV=0

FOR

               SET MDPROV=$ORDER(^TMP("PXKENC",$JOB,MDVST,"PRV",MDPROV))

               if 'MDPROV

                   QUIT

               Begin DoDot:1

 +75               QUIT

 +76               SET MDX0=$GET(^TMP("PXKENC",$JOB,MDVST,"PRV",MDPROV,0))

 +77               SET CODE=+$PIECE(MDX0,U)

 +78               IF +CODE

                       SET MDCTR=MDCTR+1

                       SET @RESULTS@(MDCTR)="PRV"_U_CODE_U_U_$$GET1^DIQ(200,+CODE_",",.01,"E")_U_U_($PIECE(MDX0,U,4)="P")

               End DoDot:1

 +79      ;^TMP("MDENC",$J,n)="POV"^ICD9 IEN^ICD9 CODE^provider narrative category^provider narrative (Short Description)^Primary (1=Yes,0=No)

 +80       SET MDICD=0

FOR

               SET MDICD=$ORDER(^TMP("PXKENC",$JOB,MDVST,"POV",MDICD))

               if 'MDICD

                   QUIT

               Begin DoDot:1

 +81               SET MDX0=$GET(^TMP("PXKENC",$JOB,MDVST,"POV",MDICD,0))

                   SET MDX802=$GET(^(802))

 +82               SET CODE=+$GET(MDX0,U)

                   SET GDIAG=$$ICDDATA^ICDXCODE(80,CODE,MDENCDT)

 +83               if CODE

                       SET DIAG=$PIECE(GDIAG,U,2)_U_$PIECE(GDIAG,U,4)

 +84               SET CAT=$PIECE(MDX802,U)

 +85               if CAT

                       SET CAT=$PIECE($GET(^AUTNPOV(CAT,0)),U)

 +86               SET MDCTR=MDCTR+1

                   SET @RESULTS@(MDCTR)="POV"_U_+$GET(MDX0,U)_U_$PIECE(DIAG,U)_U_CAT_U_$PIECE(DIAG,U,2)_U_($PIECE(MDX0,U,12)="P")

               End DoDot:1

 +87      ;^TMP("MDENC",$J,n)="CPT"^CPT IEN^CPT CODE^provider narrative category^provider narrative (Short Description)^^Quantity

 +88       SET MDCPT=0

FOR

               SET MDCPT=$ORDER(^TMP("PXKENC",$JOB,MDVST,"CPT",MDCPT))

               if 'MDCPT

                   QUIT

               Begin DoDot:1

 +89               SET MDX0=$GET(^TMP("PXKENC",$JOB,MDVST,"CPT",MDCPT,0))

                   SET MDX802=$GET(^(802))

 +90               SET CODE=+$GET(MDX0,U)

 +91               if CODE

                       SET CODE=$$CPT^ICPTCOD(CODE,MDVST)

 +92               if CODE

                       SET DIAG=$PIECE(CODE,U,2,3)

 +93               SET CAT=$PIECE(MDX802,U)

 +94               if CAT

                       SET CAT=$PIECE($GET(^AUTNPOV(CAT,0)),U)

 +95               SET QTY=$PIECE(MDX0,U,16)

 +96               SET MDDESC=""

                   DO CPTLEX^MDRPCWU(.RESLT,$PIECE(DIAG,U),"CPT")

 +97               SET MDCLL=""

FOR

                       SET MDCLL=$ORDER(^TMP("MDLEX",$JOB,MDCLL))

                       if MDCLL<1

                           QUIT

                       SET MDDESC=$PIECE(^(MDCLL),"^",3)

 +98               if $LENGTH(MDDESC)>230

                       SET MDDESC=$EXTRACT(MDDESC,1,230)

                   KILL ^TMP("MDLEX",$JOB),RESLT

 +99               if MDDESC=""

                       SET MDDESC=$PIECE(DIAG,U,2)

 +100              SET MDCTR=MDCTR+1

                   SET @RESULTS@(MDCTR)="CPT"_U_+$GET(MDX0,U)_U_$PIECE(DIAG,U)_U_CAT_U_MDDESC_U_U_QTY

               End DoDot:1

 +101      KILL ^TMP("PXKENC",$JOB)

 +102      QUIT

SETGLO(MDGLO1,MDGLO2) ; Set the ICD and CPT from device into a global array

 +1        NEW MDA,MDB,MDC

 +2        IF +$GET(@MDGLO1@(1))<1&(+$GET(@MDGLO1@(2))<1)

               QUIT

 +3        SET MDA=$ORDER(@MDGLO2@("POV",""),-1)

 +4        SET MDB=$ORDER(@MDGLO2@("CPT",""),-1)

 +5        FOR MDC=1:1:+$GET(@MDGLO1@(1))

               SET MDA=MDA+1

               SET @MDGLO2@("POV",MDA)=$GET(@MDGLO1@(1,MDC))

 +6        FOR MDC=1:1:+$GET(@MDGLO1@(2))

               SET MDB=MDB+1

               SET @MDGLO2@("CPT",MDB)=$GET(@MDGLO1@(2,MDC))

 +7        SET @MDGLO2@("POV",0)=MDA

           SET @MDGLO2@("CPT",0)=MDB

 +8        QUIT

NTIU(P1,RECID) ; Create New TIU note for Result

 +1        IF $GET(^MDD(702,+P1,0))=""

               QUIT 0

 +2        NEW MDNEWN,MDFG,MDHVL,MDKK

           SET MDFG=0

 +3        DO GETLST^XPAR(.MDHVL,"SYS","MD GET HIGH VOLUME")

 +4        FOR MDKK=0:0

               SET MDKK=$ORDER(MDHVL(MDKK))

               if MDKK<1

                   QUIT

               IF $PIECE($GET(MDHVL(MDKK)),"^")=+$PIECE(^MDD(702,+P1,0),U,4)

                   SET MDFG=1

                   QUIT

 +5        IF $PIECE($GET(^MDS(702.01,+$PIECE(^MDD(702,+P1,0),U,4),0)),U,6)=2

               SET MDNEWN=$$NEWTIUN^MDRPCOT2(+P1)

 +6        IF +$PIECE($GET(^MDS(702.01,+$PIECE(^MDD(702,+P1,0),U,4),0)),U,10)!(+MDFG)

               SET MDNEWN=$$NEWTIUN^MDRPCOTH(+P1,RECID)

 +7        QUIT 1

MDRPCW1.m