Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXCEVFIL

PXCEVFIL.m

Go to the documentation of this file.
  1. PXCEVFIL ;ISL/dee - Main routine to edit a visit or v-file entry ;10/06/2017
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**9,30,22,73,88,89,104,147,124,169,210,215,211**;Aug 12, 1996;Build 454
  1. ;
  1. Q
  1. EN(PXCECAT) ; -- main entry point for PXCE pxcecat EDIT
  1. I PXCECAT="SIT"!(PXCECAT="HIST") D PATINFO^PXCEPAT(.PXCEPAT) Q:$D(DIRUT)
  1. I PXCECAT'="SIT",PXCECAT'="APPM",PXCECAT'="HIST" Q:'$D(PXCEFIEN)!'$D(PXCEVIEN)!'$D(PXCEPAT)
  1. E Q:(PXCEVIEW["P"&'$D(PXCEPAT))!(PXCEVIEW["H"&'$D(PXCEHLOC))!("~H~P~"'[("~"_$P(PXCEVIEW,"^")_"~"))
  1. I PXCECAT="CSTP",$L($T(DATE^SCDXUTL)),$$DATE^SCDXUTL(+$G(^AUPNVSIT(PXCEVIEN,0))) W !!,$C(7),"Stop Codes can not be added to encounters after "_$$FMDATE^SCDXUTL Q
  1. N PXCEQUIT
  1. I "~CPT~CSTP~"[PXCECAT D Q:PXCEQUIT
  1. . S PXCEQUIT=0
  1. . I $P($G(^AUPNVSIT(PXCEVIEN,0)),"^",7)="E" D Q:$G(PXCEQUIT)
  1. .. I PXCECAT="CSTP" W !!,$C(7),"Historical Encounters cannot have Stop Codes." D WAIT^PXCEHELP S PXCEQUIT=1 Q
  1. K PXCEQUIT
  1. D FULL^VALM1
  1. ;
  1. N PXCEVFIL,PXCELOOP,PXCENOER
  1. N PXCECODE,PXCEAUPN,PXCECATS,PXCECATT,PXCEFILE,PXVICR ; PX*1*215
  1. N PXCEPSCC
  1. S PXCECATS=$S(PXCECAT="SIT":"VST",PXCECAT="APPM":"VST",PXCECAT="HIST":"VST",PXCECAT="CSTP":"VST",1:PXCECAT)
  1. S PXCECODE="PXCE"_$S(PXCECAT="IMM":"VIMM",1:PXCECAT)
  1. S PXCEAUPN=$P($T(FORMAT^@PXCECODE),"~",5)
  1. S PXCECATT=$P($P($T(FORMAT^@PXCECODE),";;",2),"~",1)
  1. S PXCEFILE=$P($T(FORMAT^@PXCECODE),"~",2)
  1. S (PXCEQUIT,PXVICR)=0
  1. I '$D(PXCAAFTR),PXCECAT'="SIT",PXCECAT'="APPM",PXCECAT'="HIST",PXCEFIEN'>0 D ASK^PXCEVFI2(PXCEVIEN,.PXCEFIEN,PXCEAUPN,PXCECATT,PXCECODE)
  1. Q:PXCEQUIT
  1. I PXVICR S PXCEFIEN="" D EN("ICR") Q ; PX*1*215
  1. I PXCECAT'="SIT",PXCECAT'="APPM",PXCECAT'="HIST" S PXCELOOP=+PXCEFIEN
  1. E S PXCELOOP=1,PXCEFIEN=PXCEVIEN
  1. I PXCECAT="CSTP" D
  1. . I $$VSTAPPT^PXUTL1(PXCEPAT,+^AUPNVSIT(PXCEVIEN,0),PXCEHLOC,PXCEVIEN) S PXCELOOP=0
  1. . E S PXCELOOP=1
  1. I $D(PXCAAFTR) S PXCELOOP=1
  1. F D DOONE Q:PXCELOOP
  1. K PXCEFIEN
  1. Q
  1. ;
  1. DOONE ;
  1. N PXCEAFTR,PXCEUP,PXCEVFIN,PXELAP
  1. D INIT
  1. ;Save the initial V-file contents.
  1. M PXCEVFIN=PXCEAFTR
  1. Q:PXCEQUIT
  1. DOONE2 ;
  1. K PXKERROR
  1. S PXCENOER=0
  1. I PXCECAT="IMM" S PXVNEWDA="" ; PX*1*210
  1. D EDIT^PXCEVFI1
  1. I 'PXCEQUIT,PXCECAT="SIT",$P($G(PXCEAFTR(0)),"^")]"",$P($G(PXCEAFTR(0)),"^",22)]"" D
  1. . I $D(^DPT(DFN,"S",$P(PXCEAFTR(0),"^"),0)),$P($G(^DPT(DFN,"S",$P(PXCEAFTR(0),"^"),0)),"^")=$P(PXCEAFTR(0),"^",22),$P(^DPT(DFN,"S",$P(PXCEAFTR(0),"^"),0),"^",2)["C" D
  1. .. S PXCEQUIT=1,$P(PXCEAFTR(0),"^")=""
  1. .. W !,$C(7),"Cannot create encounter for appointment date/time and clinic that was previously cancelled, NOTHING was STORED"
  1. .. D WAIT^PXCEHELP
  1. I ($P(PXCEAFTR(0),"^")]"") D
  1. . I PXCEQUIT D
  1. .. I 'PXCEFIEN,PXCECAT="CPT" D
  1. ... D REMOVE(^TMP("PXK",$J,PXCECAT,1,"IEN"))
  1. .. I 'PXCENOER D
  1. ... I PXCEFIEN>0 D
  1. .... D:PXCECAT="CPT" MODUPD
  1. .... W !,$C(7),"The last entry did not have all of the required data and NOTHING was CHANGED."
  1. ... E W !,$C(7),"The last entry did not have all of the required data and NOTHING was STORED."
  1. ... D WAIT^PXCEHELP
  1. . E D SAVE^PXCEVFI2
  1. I PXCECAT="IMM",$G(PXVNEWDA) D EVIS^PXCEVIS K PXVNEWDA ; PX*1*210
  1. D EXIT
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. N PXCENODS,PXCEFOR,PXCENODE
  1. K ^TMP("PXK",$J),PXCEAFTR
  1. S ^TMP("PXK",$J,"SOR")=PXCESOR
  1. S ^TMP("PXK",$J,"VST",1,"IEN")=PXCEVIEN
  1. I PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST") D
  1. . F PXCENODE=0,21,150,800,811,812 D
  1. .. S PXCEAFTR(PXCENODE)=$S(PXCEVIEN>0:$G(^AUPNVSIT(PXCEVIEN,PXCENODE)),1:"")
  1. .. S ^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE")=PXCEAFTR(PXCENODE)
  1. E D
  1. . F PXCENODE=0,21,150,800,811,812 D
  1. .. S ^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE")=$G(^AUPNVSIT(+PXCEVIEN,PXCENODE))
  1. .. S ^TMP("PXK",$J,"VST",1,PXCENODE,"AFTER")=^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE")
  1. . ;
  1. . S ^TMP("PXK",$J,PXCECATS,1,"IEN")=PXCEFIEN
  1. . S PXCENODS=$P($T(FORMAT^@PXCECODE),"~",3)
  1. . F PXCEFOR=1:1 S PXCENODE=$P(PXCENODS,",",PXCEFOR) Q:PXCENODE']"" D
  1. .. I PXCEFIEN>0 D
  1. ... I PXCECAT="CPT",PXCENODE=1 D
  1. .... ;Retrieve CPT Modifiers from multiple field
  1. .... S PXCESEQ=0
  1. .... F S PXCESEQ=$O(@(PXCEAUPN_"(PXCEFIEN,PXCENODE,PXCESEQ)")) Q:'PXCESEQ D
  1. ..... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,PXCESEQ,"BEFORE")=$G(@(PXCEAUPN_"(PXCEFIEN,PXCENODE,PXCESEQ,0)"))
  1. ..... S PXCEAFTR(PXCENODE,PXCESEQ)=^TMP("PXK",$J,PXCECATS,1,PXCENODE,PXCESEQ,"BEFORE")
  1. ... E D
  1. .... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")=$G(@(PXCEAUPN_"(PXCEFIEN,PXCENODE)"))
  1. .... S PXCEAFTR(PXCENODE)=^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")
  1. .. E D
  1. ... I PXCECAT="CPT",PXCENODE=1 D Q
  1. .... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,1,"BEFORE")=""
  1. ... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")=""
  1. ... S PXCEAFTR(PXCENODE)=^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")
  1. Q:PXCEQUIT
  1. ;
  1. I PXCEAUPN'="^AUPNVSIT" D
  1. . ;Set the Patient and Visit pointers in the V-File.
  1. . S:'$P(PXCEAFTR(0),"^",2) $P(PXCEAFTR(0),"^",2)=PXCEPAT
  1. . S:'$P(PXCEAFTR(0),"^",3) $P(PXCEAFTR(0),"^",3)=PXCEVIEN
  1. . I $P(PXCEAFTR(0),"^",1)="" D
  1. .. S:'$P(PXCEAFTR(812),"^",2) $P(PXCEAFTR(812),"^",2)=PXCEPKG
  1. .. S:'$P(PXCEAFTR(812),"^",3) $P(PXCEAFTR(812),"^",3)=PXCESOR
  1. E D
  1. . ;If new visit set package and source.
  1. . I $P(PXCEAFTR(0),"^",1)="" D
  1. .. S:'$P(PXCEAFTR(812),"^",2) $P(PXCEAFTR(812),"^",2)=PXCEPKG
  1. .. S:'$P(PXCEAFTR(812),"^",3) $P(PXCEAFTR(812),"^",3)=PXCESOR
  1. . ;Set the Patient in the Visit for new visit.
  1. . I $G(PXCEAPDT)>0 D
  1. .. S:'$P(PXCEAFTR(0),"^",1) $P(PXCEAFTR(0),"^",1)=PXCEAPDT
  1. .. I '$P(PXCEAFTR(0),"^",21) D
  1. ... ;Get the ELIGIBILITY for the appointment
  1. ... N PXCEELIG
  1. ... S PXCEELIG=$$ELIGIBIL^PXCEVSIT(PXCEPAT,PXCEHLOC,PXCEAPDT)
  1. ... S:PXCEELIG>0 $P(PXCEAFTR(0),"^",21)=PXCEELIG
  1. . S:'$P(PXCEAFTR(0),"^",5)&($G(PXCEPAT)>0) $P(PXCEAFTR(0),"^",5)=PXCEPAT
  1. . S:'$P(PXCEAFTR(0),"^",22)&($G(PXCEHLOC)>0) $P(PXCEAFTR(0),"^",22)=PXCEHLOC
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. I PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST") L:PXCEVIEN>0 -@(PXCEAUPN_"(PXCEVIEN)"):30
  1. E L:PXCEFIEN>0 -@(PXCEAUPN_"(PXCEFIEN)"):30
  1. S PXCEFIEN=""
  1. K ^TMP("PXK",$J)
  1. K PXCEAFTR
  1. S PXCEQUIT=0
  1. Q
  1. ;
  1. MODUPD ;Update the MODIFIER list for the currently edited CPT code when all
  1. ;the reqired data is not entered.
  1. ;
  1. N SQ,DA,DIC,DIK,X
  1. S SQ=""
  1. F S SQ=$O(PXCEAFTR(1,SQ)) Q:'SQ D
  1. .S DA(1)=PXCEFIEN,DA=SQ
  1. .S DIK="^AUPNVCPT("_DA(1)_","_1_","
  1. .D ^DIK
  1. F S SQ=$O(^TMP("PXK",$J,"CPT",1,1,SQ)) Q:'SQ D
  1. .S X=^TMP("PXK",$J,"CPT",1,1,SQ,"BEFORE")
  1. .Q:X']""
  1. .K DD,DO
  1. .S DA(1)=PXCEFIEN
  1. .S DIC="^AUPNVCPT("_DA(1)_","_1_","
  1. .S DIC(0)="L",DIC("P")=$P(^DD(9000010.18,1,0),"^",2)
  1. .D FILE^DICN
  1. Q
  1. ;
  1. REMOVE(DA) ;REMOVE INCOMPLETE CPT ENTRY
  1. N DIK
  1. S DIK="^AUPNVCPT("
  1. I $G(DA) D ^DIK ;PX*1*124
  1. Q