PXKFPOV1 ;BPFO/LMT - PROMBLEM OF VISIT Routine #2 ;01/12/16 14:36
;;1.0;PCE PATIENT CARE ENCOUNTER;**215**;Aug 12, 1996;Build 10
;
;
IMM ;
D MAIN
Q
SK ;
D MAIN
Q
;
MAIN ;
I PXKFGAD=1 D ADD
I PXKFGDE=1 D DEL
Q
;
ADD ;
N PXKSEQ1,PXNARR,PXVISIT,PXVISITDT
;
S PXVISIT=$G(^TMP("PXK",$J,"VST",1,"IEN"))
;
; Entry already exists with this Code - don't add duplicate
I $$FNDVPOV(PXVISIT,PXCODE) Q
;
; use diagnosis description as narrative
S PXVISITDT=$$CSDATE^PXDXUTL(PXVISIT)
S PXNARR=$$DXNARR^PXUTL1(PXCODE,PXVISITDT)
S PXNARR=+$$PROVNARR^PXAPI(PXNARR,9000010.07)
;
S PXKSEQ1=PXKSEQ+PXKXX
S ^TMP("PXKSAVE",$J,"POV",PXKSEQ1,0,"AFTER")=PXCODE_"^"_$G(PXKAV(0,2))_"^"_$G(PXKAV(0,3))_"^"_PXNARR_"^^^^^^^^S"
S ^TMP("PXKSAVE",$J,"POV",PXKSEQ1,12,"AFTER")=$G(PXKAV(12,1))_"^"_$G(PXKAV(12,2))_"^^"_$G(PXKAV(12,4))
S ^TMP("PXKSAVE",$J,"POV",PXKSEQ1,812,"AFTER")=$G(PXKAFT(812))
S ^TMP("PXKSAVE",$J,"POV",PXKSEQ1,"IEN")=""
;
Q
;
DEL ;
N PXKSEQ1,PXVISIT,PXVPOV
;
S PXVISIT=$G(^TMP("PXK",$J,"VST",1,"IEN"))
;
S PXVPOV=$$FNDVPOV(PXVISIT,PXCODE)
I 'PXVPOV Q
;
S PXKSEQ1=PXKSEQ+PXKXX
S ^TMP("PXKSAVE",$J,"POV",PXKSEQ1,0,"BEFORE")=$G(^AUPNVPOV(PXVPOV,0))
S ^TMP("PXKSAVE",$J,"POV",PXKSEQ1,12,"BEFORE")=$G(^AUPNVPOV(PXVPOV,12))
S ^TMP("PXKSAVE",$J,"POV",PXKSEQ1,800,"BEFORE")=$G(^AUPNVPOV(PXVPOV,800))
S ^TMP("PXKSAVE",$J,"POV",PXKSEQ1,802,"BEFORE")=$G(^AUPNVPOV(PXVPOV,802))
S ^TMP("PXKSAVE",$J,"POV",PXKSEQ1,811,"BEFORE")=$G(^AUPNVPOV(PXVPOV,811))
S ^TMP("PXKSAVE",$J,"POV",PXKSEQ1,812,"BEFORE")=$G(^AUPNVPOV(PXVPOV,812))
S ^TMP("PXKSAVE",$J,"POV",PXKSEQ1,"IEN")=PXVPOV
;
S ^TMP("PXKSAVE",$J,"POV",PXKSEQ1,0,"AFTER")="@"
S ^TMP("PXKSAVE",$J,"POV",PXKSEQ1,12,"AFTER")=""
S ^TMP("PXKSAVE",$J,"POV",PXKSEQ1,812,"AFTER")=""
;
Q
;
DUP(PXVISIT,PXCODE) ;
N PXFOUND,PXSEQ
;
I $$FNDVPOV(PXVISIT,PXCODE) Q 1
;
S PXFOUND=0
S PXSEQ=0
F Q:PXFOUND S PXSEQ=$O(^TMP("PXK",$J,"POV",PXSEQ)) Q:'PXSEQ D
. I $P($G(^TMP("PXK",$J,"POV",PXSEQ,0,"AFTER")),U,1)=PXCODE D
. . S PXFOUND=1
;
Q PXFOUND
;
FNDVPOV(PXVISIT,PXCODE) ;
N PXFOUND,PXRSLT,PXVPOV
;
S PXRSLT=0
S PXFOUND=0
;
S PXVPOV=0
F Q:PXFOUND S PXVPOV=$O(^AUPNVPOV("AD",PXVISIT,PXVPOV)) Q:'PXVPOV D
. I $P($G(^AUPNVPOV(PXVPOV,0)),U,1)=PXCODE D
. . S PXFOUND=1
. . S PXRSLT=PXVPOV
;
Q PXRSLT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXKFPOV1 2374 printed Sep 02, 2024@19:14:38 Page 2
PXKFPOV1 ;BPFO/LMT - PROMBLEM OF VISIT Routine #2 ;01/12/16 14:36
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**215**;Aug 12, 1996;Build 10
+2 ;
+3 ;
IMM ;
+1 DO MAIN
+2 QUIT
SK ;
+1 DO MAIN
+2 QUIT
+3 ;
MAIN ;
+1 IF PXKFGAD=1
DO ADD
+2 IF PXKFGDE=1
DO DEL
+3 QUIT
+4 ;
ADD ;
+1 NEW PXKSEQ1,PXNARR,PXVISIT,PXVISITDT
+2 ;
+3 SET PXVISIT=$GET(^TMP("PXK",$JOB,"VST",1,"IEN"))
+4 ;
+5 ; Entry already exists with this Code - don't add duplicate
+6 IF $$FNDVPOV(PXVISIT,PXCODE)
QUIT
+7 ;
+8 ; use diagnosis description as narrative
+9 SET PXVISITDT=$$CSDATE^PXDXUTL(PXVISIT)
+10 SET PXNARR=$$DXNARR^PXUTL1(PXCODE,PXVISITDT)
+11 SET PXNARR=+$$PROVNARR^PXAPI(PXNARR,9000010.07)
+12 ;
+13 SET PXKSEQ1=PXKSEQ+PXKXX
+14 SET ^TMP("PXKSAVE",$JOB,"POV",PXKSEQ1,0,"AFTER")=PXCODE_"^"_$GET(PXKAV(0,2))_"^"_$GET(PXKAV(0,3))_"^"_PXNARR_"^^^^^^^^S"
+15 SET ^TMP("PXKSAVE",$JOB,"POV",PXKSEQ1,12,"AFTER")=$GET(PXKAV(12,1))_"^"_$GET(PXKAV(12,2))_"^^"_$GET(PXKAV(12,4))
+16 SET ^TMP("PXKSAVE",$JOB,"POV",PXKSEQ1,812,"AFTER")=$GET(PXKAFT(812))
+17 SET ^TMP("PXKSAVE",$JOB,"POV",PXKSEQ1,"IEN")=""
+18 ;
+19 QUIT
+20 ;
DEL ;
+1 NEW PXKSEQ1,PXVISIT,PXVPOV
+2 ;
+3 SET PXVISIT=$GET(^TMP("PXK",$JOB,"VST",1,"IEN"))
+4 ;
+5 SET PXVPOV=$$FNDVPOV(PXVISIT,PXCODE)
+6 IF 'PXVPOV
QUIT
+7 ;
+8 SET PXKSEQ1=PXKSEQ+PXKXX
+9 SET ^TMP("PXKSAVE",$JOB,"POV",PXKSEQ1,0,"BEFORE")=$GET(^AUPNVPOV(PXVPOV,0))
+10 SET ^TMP("PXKSAVE",$JOB,"POV",PXKSEQ1,12,"BEFORE")=$GET(^AUPNVPOV(PXVPOV,12))
+11 SET ^TMP("PXKSAVE",$JOB,"POV",PXKSEQ1,800,"BEFORE")=$GET(^AUPNVPOV(PXVPOV,800))
+12 SET ^TMP("PXKSAVE",$JOB,"POV",PXKSEQ1,802,"BEFORE")=$GET(^AUPNVPOV(PXVPOV,802))
+13 SET ^TMP("PXKSAVE",$JOB,"POV",PXKSEQ1,811,"BEFORE")=$GET(^AUPNVPOV(PXVPOV,811))
+14 SET ^TMP("PXKSAVE",$JOB,"POV",PXKSEQ1,812,"BEFORE")=$GET(^AUPNVPOV(PXVPOV,812))
+15 SET ^TMP("PXKSAVE",$JOB,"POV",PXKSEQ1,"IEN")=PXVPOV
+16 ;
+17 SET ^TMP("PXKSAVE",$JOB,"POV",PXKSEQ1,0,"AFTER")="@"
+18 SET ^TMP("PXKSAVE",$JOB,"POV",PXKSEQ1,12,"AFTER")=""
+19 SET ^TMP("PXKSAVE",$JOB,"POV",PXKSEQ1,812,"AFTER")=""
+20 ;
+21 QUIT
+22 ;
DUP(PXVISIT,PXCODE) ;
+1 NEW PXFOUND,PXSEQ
+2 ;
+3 IF $$FNDVPOV(PXVISIT,PXCODE)
QUIT 1
+4 ;
+5 SET PXFOUND=0
+6 SET PXSEQ=0
+7 FOR
if PXFOUND
QUIT
SET PXSEQ=$ORDER(^TMP("PXK",$JOB,"POV",PXSEQ))
if 'PXSEQ
QUIT
Begin DoDot:1
+8 IF $PIECE($GET(^TMP("PXK",$JOB,"POV",PXSEQ,0,"AFTER")),U,1)=PXCODE
Begin DoDot:2
+9 SET PXFOUND=1
End DoDot:2
End DoDot:1
+10 ;
+11 QUIT PXFOUND
+12 ;
FNDVPOV(PXVISIT,PXCODE) ;
+1 NEW PXFOUND,PXRSLT,PXVPOV
+2 ;
+3 SET PXRSLT=0
+4 SET PXFOUND=0
+5 ;
+6 SET PXVPOV=0
+7 FOR
if PXFOUND
QUIT
SET PXVPOV=$ORDER(^AUPNVPOV("AD",PXVISIT,PXVPOV))
if 'PXVPOV
QUIT
Begin DoDot:1
+8 IF $PIECE($GET(^AUPNVPOV(PXVPOV,0)),U,1)=PXCODE
Begin DoDot:2
+9 SET PXFOUND=1
+10 SET PXRSLT=PXVPOV
End DoDot:2
End DoDot:1
+11 ;
+12 QUIT PXRSLT
