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 ---[H[J[2J[HMDRPCW 9626 printed Dec 13, 2024@01:44:15 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")
End DoDot:1
+74 ;^TMP("MDENC",$J,n)="POV"^ICD9 IEN^ICD9 CODE^provider narrative category^provider narrative (Short Description)^Primary (1=Yes,0=No)
+75 SET MDICD=0
FOR
SET MDICD=$ORDER(^TMP("PXKENC",$JOB,MDVST,"POV",MDICD))
if 'MDICD
QUIT
Begin DoDot:1
+76 SET MDX0=$GET(^TMP("PXKENC",$JOB,MDVST,"POV",MDICD,0))
SET MDX802=$GET(^(802))
+77 SET CODE=+$GET(MDX0,U)
SET GDIAG=$$ICDDATA^ICDXCODE(80,CODE,MDENCDT)
+78 if CODE
SET DIAG=$PIECE(GDIAG,U,2)_U_$PIECE(GDIAG,U,4)
+79 SET CAT=$PIECE(MDX802,U)
+80 if CAT
SET CAT=$PIECE($GET(^AUTNPOV(CAT,0)),U)
+81 SET MDCTR=MDCTR+1
SET @RESULTS@(MDCTR)="Diagnosis: "_$PIECE(DIAG,U,2)_" "_$SELECT($PIECE(MDX0,U,12)="P":"Primary",1:"")
End DoDot:1
+82 SET MDCPT=0
FOR
SET MDCPT=$ORDER(^TMP("PXKENC",$JOB,MDVST,"CPT",MDCPT))
if 'MDCPT
QUIT
Begin DoDot:1
+83 SET MDX0=$GET(^TMP("PXKENC",$JOB,MDVST,"CPT",MDCPT,0))
SET MDX802=$GET(^(802))
+84 SET CODE=+$GET(MDX0,U)
+85 if CODE
SET CODE=$$CPT^ICPTCOD(CODE,MDVST)
+86 if CODE
SET DIAG=$PIECE(CODE,U,2,3)
+87 SET CAT=$PIECE(MDX802,U)
+88 if CAT
SET CAT=$PIECE($GET(^AUTNPOV(CAT,0)),U)
+89 SET QTY=$PIECE(MDX0,U,16)
+90 SET MDDESC=""
DO CPTLEX^MDRPCWU(.RESLT,$PIECE(DIAG,U),"CPT")
+91 SET MDCLL=""
FOR
SET MDCLL=$ORDER(^TMP("MDLEX",$JOB,MDCLL))
if MDCLL<1
QUIT
SET MDDESC=$PIECE(^(MDCLL),"^",3)
+92 if $LENGTH(MDDESC)>230
SET MDDESC=$EXTRACT(MDDESC,1,230)
KILL ^TMP("MDLEX",$JOB),RESLT
+93 if MDDESC=""
SET MDDESC=$PIECE(DIAG,U,2)
+94 SET MDCTR=MDCTR+1
SET @RESULTS@(MDCTR)="CPT: "_MDDESC_"-"_QTY
End DoDot:1
+95 KILL ^TMP("PXKENC",$JOB)
+96 QUIT
TIMEMET ; Check if appointment time is met
+1 NEW MDNOW,MDTIM,MDV
+2 SET MDV=$$GET1^DIQ(702,+MDSTUD_",",.07,"I")
+3 IF $GET(MDV)=""
SET @RESULTS@(0)="-1^No Visit."
QUIT
+4 IF $LENGTH(MDV,";")=1
SET MDTIM=MDV
+5 IF '$TEST
SET MDTIM=$PIECE(MDV,";",2)
+6 IF 'MDTIM
SET @RESULTS@(0)="-1^No Visit Date/Time."
QUIT
+7 DO NOW^%DTC
SET MDNOW=%
KILL %
+8 IF MDNOW<MDTIM
SET @RESULTS@(0)="0^Appointment/Visit Date/Time not met."
QUIT
+9 SET @RESULTS@(0)="1^Appointment/Visit Date/Time have met."
+10 QUIT
