MDRPCW.m

MDRPCW ; HOIFO/NCA - Calls to AICS ;01/21/10  11:51

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

 ; Reference Integration Agreement:

 ; IA #142 [Subscription] Access ^DIC(31 NAME field (#.01) with FM

 ; IA #174 [Subscription] Access DPT(DFN,.372) node.

 ; IA #649 [Subscription] Access DG(391 with FM for

 ;                        IGNORE VETERAN CHECK field (#.02).

 ; IA #1296 [Subscription] IBDF18A call

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

 ;                         (#9999999.27)

 ; IA #1894 [Subscription] PXAPI call

 ; IA #1995 [Supported] ICPTCOD calls

 ; IA #2054 [Supported] Call to DILF

 ; IA #2056 [Supported] Call to DIQ

 ; IA #5699 [Supported] ICDDATA^ICDXCODE calls

 ; IA #10060 [Supported] Access File 200

 ; IA #10061 [Supported] VADPT calls

 ; IA #5747 [Subscription] Access to $$SINFO^ICDEX

 ;

 Q

RPC(RESULTS,OPTION,DFN,MDSTUD) ; [Procedure] Main RPC call

 ; RPC: [MD TMDCIDC]

 ;

 ; DFN=Patient internal entry number in Patient file (#2)

 ; MDSTUD=CP study internal entry number

 ;

 D CLEAN^DILF

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

 I $G(MDSTUD)="" S @RESULTS@(0)="-1^No Study." Q

 I $T(@OPTION)="" D  Q

 .S @RESULTS@(0)="-1^Error in RPC: MD TMDCIDC at "_OPTION_U_$T(+0)

 D @OPTION S:'$D(@RESULTS) @RESULTS@(0)="-1^No return"

 D CLEAN^DILF

 Q

PROC ; get list of procedures for clinic

 N CLIN,MDARR,MDPR,MDV

 S MDV=$$GET1^DIQ(702,+MDSTUD_",",.07,"I")

 I $G(MDV)="" S @RESULTS@(0)="-1^No Visit." Q

 S MDPR=$$GET1^DIQ(702,+MDSTUD_",",.04,"I")

 I '$G(MDPR) S @RESULTS@(0)="-1^No CP Definition." Q

 S CLIN=$$GET1^DIQ(702.01,+MDPR_",",.05,"I")

 I 'CLIN S CLIN=+$P(MDV,";",3) I 'CLIN S @RESULTS@(0)="-1^No Hospital Location." Q

 D GETLST^IBDF18A(CLIN,"DG SELECT CPT PROCEDURE CODES","MDARR",,,1,DT)

 N MDIDX,MDMOD,CODES,MDFST S MDIDX=0 M @RESULTS=MDARR

 F  S MDIDX=$O(@RESULTS@(MDIDX)) Q:'+MDIDX  D

 . I @RESULTS@(MDIDX)="" K @RESULTS@(MDIDX) Q

 . S MDMOD=0,CODES="",MDFST=1

 . F  S MDMOD=$O(@RESULTS@(MDIDX,"MODIFIER",MDMOD)) Q:(MDMOD="")  D

 . . I MDFST S MDFST=0

 . . E  S CODES=CODES_";"

 . . S CODES=CODES_@RESULTS@(MDIDX,"MODIFIER",MDMOD)

 . K @RESULTS@(MDIDX,"MODIFIER")

 . I 'MDFST S $P(@RESULTS@(MDIDX),U,12)=CODES

 Q

DIAG ; get list of diagnoses for clinic

 N CLIN,MDARR,MDPR,MDV,MDENCDT,MDCS,MDNAME

 S MDV=$$GET1^DIQ(702,+MDSTUD_",",.07,"I")

 I $G(MDV)="" S @RESULTS@(0)="-1^No Visit." Q

 S MDENCDT=$P($P(MDV,";",2),".",1)

 S MDPR=$$GET1^DIQ(702,+MDSTUD_",",.04,"I")

 I '$G(MDPR) S @RESULTS@(0)="-1^No CP Definition." Q

 S CLIN=$$GET1^DIQ(702.01,+MDPR_",",.05,"I")

 I 'CLIN S CLIN=+$P(MDV,";",3) I 'CLIN S @RESULTS@(0)="-1^No Hospital Location." Q

 S MDCS=+$$SINFO^ICDEX("DIAG",MDENCDT)

 S MDNAME="DG SELECT "_$S(MDCS=1:"ICD-9",MDCS=30:"ICD-10",1:"ICD")_" DIAGNOSIS CODES"

 D GETLST^IBDF18A(CLIN,MDNAME,"MDARR",,,,MDENCDT)

 M @RESULTS=MDARR

 Q

SCDISP ; Return Service Connected % and Rated Disabilities

 N VAEL,VAERR,I,MDLST,DIS,MDSC,X2

 D ELIG^VADPT

 S:'+VAEL(3) @RESULTS@(1)="Service Connected: NO"

 S:+VAEL(3) @RESULTS@(1)="SC Percent: "_$P(VAEL(3),U,2)_"%"

 I 'VAEL(4),'$$GET1^DIQ(391,+VAEL(6)_",",.02,"I") S @RESULTS@(2)="Rated Disabilities: NOT A VETERAN." D KVAR^VADPT Q

 S @RESULTS@(2)="Rated Disabilities: "

 S I=0,MDLST=0 F  S I=$O(^DPT(DFN,.372,I)) Q:'I  S X2=^(I,0) D

 . S DIS=$$GET1^DIQ(31,+X2_",",.01,"E") Q:DIS=""

 . S MDSC=$S($P(X2,U,3):"SC",$P(X2,U,3)']"":"not specified",1:"NSC")

 . S MDLST=MDLST+1,@RESULTS@(MDLST+2)="                    "_DIS_" ("_$P(X2,U,2)_"%-"_MDSC_")"

 I 'MDLST S @RESULTS@(2)=@RESULTS@(2)_"NONE STATED"

 D KVAR^VADPT

 Q

PCEDISP ; Return print text to display PCE data

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

 S STUDY=+MDSTUD

 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 DESC,GDIAG,LLB,MDDDN,MDDDV,MDCK,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^MDRPCW1(.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,";")

 S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="Visit #: "_$S(MDVST>0:MDVST,1:"")

 I '+MDVST S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="Encounter Date/Time: "_$E(MDENCDT,4,5)_"/"_$E(MDENCDT,6,7)_"/"_$E(MDENCDT,2,3)

 I '+MDVST S MDVST=$$GETENC^PXAPI(MDDFN,MDENCDT,MDLOCN),MDVST=$S(+MDVST<1:0,1:+MDVST),MDCTR=MDCTR+1,@RESULTS@(MDCTR)="Visit # For Encounter Date: "_$S(MDVST>0:MDVST,1:"")

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

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

 .Q:'MDPFLG

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

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

 .I +CODE S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="Provider: "_$$GET1^DIQ(200,+CODE_",",.01,"E")_" "_$S($P(MDX0,U,4)="P":"Primary",1:"")

 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)="Diagnosis: "_$P(DIAG,U,2)_" "_$S($P(MDX0,U,12)="P":"Primary",1:""),MDCK=MDCK+1

 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: "_MDDESC_"-"_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=0

 ..S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="Previous Study # Used: "_+MDDDN

 ..S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="Previous Visit #: "_MDVST_" "_$E(MDENCDT,4,5)_"/"_$E(MDENCDT,6,7)_"/"_$E(MDENCDT,2,3)

 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

 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)="Diagnosis: "_$P(DIAG,U,2)_" "_$S($P(MDX0,U,12)="P":"Primary",1:"")

 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: "_MDDESC_"-"_QTY

 K ^TMP("PXKENC",$J)

 Q

TIMEMET ; Check if appointment time is met

 N MDNOW,MDTIM,MDV

 S MDV=$$GET1^DIQ(702,+MDSTUD_",",.07,"I")

 I $G(MDV)="" S @RESULTS@(0)="-1^No Visit." Q

 I $L(MDV,";")=1 S MDTIM=MDV

 E  S MDTIM=$P(MDV,";",2)

 I 'MDTIM S @RESULTS@(0)="-1^No Visit Date/Time." Q

 D NOW^%DTC S MDNOW=% K %

 I MDNOW<MDTIM S @RESULTS@(0)="0^Appointment/Visit Date/Time not met." Q

 S @RESULTS@(0)="1^Appointment/Visit Date/Time have met."

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MDRPCW   9626     printed  Feb 18, 2025@23:10:40                                                                                                                                                                                                      Page 2

MDRPCW    ; HOIFO/NCA - Calls to AICS ;01/21/10  11:51

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

 +2       ; Reference Integration Agreement:

 +3       ; IA #142 [Subscription] Access ^DIC(31 NAME field (#.01) with FM

 +4       ; IA #174 [Subscription] Access DPT(DFN,.372) node.

 +5       ; IA #649 [Subscription] Access DG(391 with FM for

 +6       ;                        IGNORE VETERAN CHECK field (#.02).

 +7       ; IA #1296 [Subscription] IBDF18A call

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

 +9       ;                         (#9999999.27)

 +10      ; IA #1894 [Subscription] PXAPI call

 +11      ; IA #1995 [Supported] ICPTCOD calls

 +12      ; IA #2054 [Supported] Call to DILF

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

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

 +15      ; IA #10060 [Supported] Access File 200

 +16      ; IA #10061 [Supported] VADPT calls

 +17      ; IA #5747 [Subscription] Access to $$SINFO^ICDEX

 +18      ;

 +19       QUIT 

RPC(RESULTS,OPTION,DFN,MDSTUD) ; [Procedure] Main RPC call

 +1       ; RPC: [MD TMDCIDC]

 +2       ;

 +3       ; DFN=Patient internal entry number in Patient file (#2)

 +4       ; MDSTUD=CP study internal entry number

 +5       ;

 +6        DO CLEAN^DILF

 +7        SET RESULTS=$NAME(^TMP("MDRPCW",$JOB))

           KILL @RESULTS

 +8        IF $GET(MDSTUD)=""

               SET @RESULTS@(0)="-1^No Study."

               QUIT 

 +9        IF $TEXT(@OPTION)=""

               Begin DoDot:1

 +10               SET @RESULTS@(0)="-1^Error in RPC: MD TMDCIDC at "_OPTION_U_$TEXT(+0)

               End DoDot:1

               QUIT 

 +11       DO @OPTION

           if '$DATA(@RESULTS)

               SET @RESULTS@(0)="-1^No return"

 +12       DO CLEAN^DILF

 +13       QUIT 

PROC      ; get list of procedures for clinic

 +1        NEW CLIN,MDARR,MDPR,MDV

 +2        SET MDV=$$GET1^DIQ(702,+MDSTUD_",",.07,"I")

 +3        IF $GET(MDV)=""

               SET @RESULTS@(0)="-1^No Visit."

               QUIT 

 +4        SET MDPR=$$GET1^DIQ(702,+MDSTUD_",",.04,"I")

 +5        IF '$GET(MDPR)

               SET @RESULTS@(0)="-1^No CP Definition."

               QUIT 

 +6        SET CLIN=$$GET1^DIQ(702.01,+MDPR_",",.05,"I")

 +7        IF 'CLIN

               SET CLIN=+$PIECE(MDV,";",3)

               IF 'CLIN

                   SET @RESULTS@(0)="-1^No Hospital Location."

                   QUIT 

 +8        DO GETLST^IBDF18A(CLIN,"DG SELECT CPT PROCEDURE CODES","MDARR",,,1,DT)

 +9        NEW MDIDX,MDMOD,CODES,MDFST

           SET MDIDX=0

           MERGE @RESULTS=MDARR

 +10       FOR 

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

               if '+MDIDX

                   QUIT 

               Begin DoDot:1

 +11               IF @RESULTS@(MDIDX)=""

                       KILL @RESULTS@(MDIDX)

                       QUIT 

 +12               SET MDMOD=0

                   SET CODES=""

                   SET MDFST=1

 +13               FOR 

                       SET MDMOD=$ORDER(@RESULTS@(MDIDX,"MODIFIER",MDMOD))

                       if (MDMOD="")

                           QUIT 

                       Begin DoDot:2

 +14                       IF MDFST

                               SET MDFST=0

 +15                      IF '$TEST

                               SET CODES=CODES_";"

 +16                       SET CODES=CODES_@RESULTS@(MDIDX,"MODIFIER",MDMOD)

                       End DoDot:2

 +17               KILL @RESULTS@(MDIDX,"MODIFIER")

 +18               IF 'MDFST

                       SET $PIECE(@RESULTS@(MDIDX),U,12)=CODES

               End DoDot:1

 +19       QUIT 

DIAG      ; get list of diagnoses for clinic

 +1        NEW CLIN,MDARR,MDPR,MDV,MDENCDT,MDCS,MDNAME

 +2        SET MDV=$$GET1^DIQ(702,+MDSTUD_",",.07,"I")

 +3        IF $GET(MDV)=""

               SET @RESULTS@(0)="-1^No Visit."

               QUIT 

 +4        SET MDENCDT=$PIECE($PIECE(MDV,";",2),".",1)

 +5        SET MDPR=$$GET1^DIQ(702,+MDSTUD_",",.04,"I")

 +6        IF '$GET(MDPR)

               SET @RESULTS@(0)="-1^No CP Definition."

               QUIT 

 +7        SET CLIN=$$GET1^DIQ(702.01,+MDPR_",",.05,"I")

 +8        IF 'CLIN

               SET CLIN=+$PIECE(MDV,";",3)

               IF 'CLIN

                   SET @RESULTS@(0)="-1^No Hospital Location."

                   QUIT 

 +9        SET MDCS=+$$SINFO^ICDEX("DIAG",MDENCDT)

 +10       SET MDNAME="DG SELECT "_$SELECT(MDCS=1:"ICD-9",MDCS=30:"ICD-10",1:"ICD")_" DIAGNOSIS CODES"

 +11       DO GETLST^IBDF18A(CLIN,MDNAME,"MDARR",,,,MDENCDT)

 +12       MERGE @RESULTS=MDARR

 +13       QUIT 

SCDISP    ; Return Service Connected % and Rated Disabilities

 +1        NEW VAEL,VAERR,I,MDLST,DIS,MDSC,X2

 +2        DO ELIG^VADPT

 +3        if '+VAEL(3)

               SET @RESULTS@(1)="Service Connected: NO"

 +4        if +VAEL(3)

               SET @RESULTS@(1)="SC Percent: "_$PIECE(VAEL(3),U,2)_"%"

 +5        IF 'VAEL(4)

               IF '$$GET1^DIQ(391,+VAEL(6)_",",.02,"I")

                   SET @RESULTS@(2)="Rated Disabilities: NOT A VETERAN."

                   DO KVAR^VADPT

                   QUIT 

 +6        SET @RESULTS@(2)="Rated Disabilities: "

 +7        SET I=0

           SET MDLST=0

           FOR 

               SET I=$ORDER(^DPT(DFN,.372,I))

               if 'I

                   QUIT 

               SET X2=^(I,0)

               Begin DoDot:1

 +8                SET DIS=$$GET1^DIQ(31,+X2_",",.01,"E")

                   if DIS=""

                       QUIT 

 +9                SET MDSC=$SELECT($PIECE(X2,U,3):"SC",$PIECE(X2,U,3)']"":"not specified",1:"NSC")

 +10               SET MDLST=MDLST+1

                   SET @RESULTS@(MDLST+2)="                    "_DIS_" ("_$PIECE(X2,U,2)_"%-"_MDSC_")"

               End DoDot:1

 +11       IF 'MDLST

               SET @RESULTS@(2)=@RESULTS@(2)_"NONE STATED"

 +12       DO KVAR^VADPT

 +13       QUIT 

PCEDISP   ; Return print text to display PCE data

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

 +2        SET STUDY=+MDSTUD

 +3        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=";"

 +4        NEW DESC,GDIAG,LLB,MDDDN,MDDDV,MDCK,MDNCTR,MDPFLG,MDCLL,MDDESC

           SET (MDCK,MDPFLG)=0

 +5        if '$GET(STUDY)

               QUIT 

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

               QUIT 

 +7        DO NOW^%DTC

           SET MDDEF=%

           KILL %

           SET MDCTR=0

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

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

           SET MDX1=$GET(^(1))

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

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

           SET MDDFN=$PIECE(MDX,U)

           if 'MDDFN

               QUIT 

 +11       if +MDVST

               SET MDPFLG=1

 +12       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

 +13       IF 'MDVST

               SET MDRP=0

               FOR 

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

                   if 'MDRP

                       QUIT 

                   Begin DoDot:1

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

 +15                   IF +MDRST

                           DO CICNV^MDHL7U3(+MDRST,.MDDAR)

                           DO SETGLO^MDRPCW1(.MDDAR,.MDDAR2)

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

                       QUIT 

                   End DoDot:1

 +17       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))

 +18       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))

 +19       IF MDVST>0

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

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

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

 +21      IF '$TEST

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

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

               SET MDVSTR=";"_MDVSTR

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

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

 +24       if 'MDENCDT

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

 +25       if 'MDENCDT

               SET MDENCDT=MDDEF

 +26       if 'MDLOCN

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

 +27       SET MDCTR=MDCTR+1

           SET @RESULTS@(MDCTR)="Visit #: "_$SELECT(MDVST>0:MDVST,1:"")

 +28       IF '+MDVST

               SET MDCTR=MDCTR+1

               SET @RESULTS@(MDCTR)="Encounter Date/Time: "_$EXTRACT(MDENCDT,4,5)_"/"_$EXTRACT(MDENCDT,6,7)_"/"_$EXTRACT(MDENCDT,2,3)

 +29       IF '+MDVST

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

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

               SET MDCTR=MDCTR+1

               SET @RESULTS@(MDCTR)="Visit # For Encounter Date: "_$SELECT(MDVST>0:MDVST,1:"")

 +30       IF +MDVST>0

               DO ENCEVENT^PXAPI(MDVST)

 +31       IF +MDVST>0

               SET MDPROV=0

               FOR 

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

                   if 'MDPROV

                       QUIT 

                   Begin DoDot:1

 +32                   if 'MDPFLG

                           QUIT 

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

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

 +35                   IF +CODE

                           SET MDCTR=MDCTR+1

                           SET @RESULTS@(MDCTR)="Provider: "_$$GET1^DIQ(200,+CODE_",",.01,"E")_" "_$SELECT($PIECE(MDX0,U,4)="P":"Primary",1:"")

                   End DoDot:1

 +36       IF +MDVST>0

               SET MDICD=0

               FOR 

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

                   if 'MDICD

                       QUIT 

                   Begin DoDot:1

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

                       SET MDX802=$GET(^(802))

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

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

 +39                   if CODE

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

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

 +41                   if CAT

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

 +42                   SET MDCTR=MDCTR+1

                       SET @RESULTS@(MDCTR)="Diagnosis: "_$PIECE(DIAG,U,2)_" "_$SELECT($PIECE(MDX0,U,12)="P":"Primary",1:"")

                       SET MDCK=MDCK+1

                   End DoDot:1

 +43       IF +MDVST>0

               SET MDCPT=0

               FOR 

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

                   if 'MDCPT

                       QUIT 

                   Begin DoDot:1

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

                       SET MDX802=$GET(^(802))

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

 +46                   if CODE

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

 +47                   if CODE

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

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

 +49                   if CAT

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

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

 +51                   SET MDDESC=""

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

 +52                   SET MDCLL=""

                       FOR 

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

                           if MDCLL<1

                               QUIT 

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

 +53                   if $LENGTH(MDDESC)>230

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

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

 +54                   if MDDESC=""

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

 +55                   SET MDCTR=MDCTR+1

                       SET @RESULTS@(MDCTR)="CPT: "_MDDESC_"-"_QTY

                       SET MDCK=MDCK+1

                   End DoDot:1

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

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

               Begin DoDot:1

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

                   SET MDVST=0

 +59               IF MDDDN

                       Begin DoDot:2

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

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

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

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

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

 +62                       IF +MDVST>0

                               SET MDNCTR=0

 +63                       SET MDCTR=MDCTR+1

                           SET @RESULTS@(MDCTR)="Previous Study # Used: "_+MDDDN

 +64                       SET MDCTR=MDCTR+1

                           SET @RESULTS@(MDCTR)="Previous Visit #: "_MDVST_" "_$EXTRACT(MDENCDT,4,5)_"/"_$EXTRACT(MDENCDT,6,7)_"/"_$EXTRACT(MDENCDT,2,3)

                       End DoDot:2

               End DoDot:1

 +65       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))

 +66       if MDCK>0

               QUIT 

 +67       if 'MDVST

               QUIT 

 +68       DO ENCEVENT^PXAPI(MDVST)

           if $GET(MDNCTR)>0

               SET MDCTR=MDNCTR

 +69       SET MDPROV=0

           FOR 

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

               if 'MDPROV

                   QUIT 

               Begin DoDot:1

 +70               QUIT 

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

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

 +73               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")