- 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 Apr 23, 2025@18:43:36 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
