- PXCEVFIL ;ISL/dee - Main routine to edit a visit or v-file entry ;10/06/2017
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**9,30,22,73,88,89,104,147,124,169,210,215,211**;Aug 12, 1996;Build 454
- ;
- Q
- EN(PXCECAT) ; -- main entry point for PXCE pxcecat EDIT
- I PXCECAT="SIT"!(PXCECAT="HIST") D PATINFO^PXCEPAT(.PXCEPAT) Q:$D(DIRUT)
- I PXCECAT'="SIT",PXCECAT'="APPM",PXCECAT'="HIST" Q:'$D(PXCEFIEN)!'$D(PXCEVIEN)!'$D(PXCEPAT)
- E Q:(PXCEVIEW["P"&'$D(PXCEPAT))!(PXCEVIEW["H"&'$D(PXCEHLOC))!("~H~P~"'[("~"_$P(PXCEVIEW,"^")_"~"))
- 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
- N PXCEQUIT
- I "~CPT~CSTP~"[PXCECAT D Q:PXCEQUIT
- . S PXCEQUIT=0
- . I $P($G(^AUPNVSIT(PXCEVIEN,0)),"^",7)="E" D Q:$G(PXCEQUIT)
- .. I PXCECAT="CSTP" W !!,$C(7),"Historical Encounters cannot have Stop Codes." D WAIT^PXCEHELP S PXCEQUIT=1 Q
- K PXCEQUIT
- D FULL^VALM1
- ;
- N PXCEVFIL,PXCELOOP,PXCENOER
- N PXCECODE,PXCEAUPN,PXCECATS,PXCECATT,PXCEFILE,PXVICR ; PX*1*215
- N PXCEPSCC
- S PXCECATS=$S(PXCECAT="SIT":"VST",PXCECAT="APPM":"VST",PXCECAT="HIST":"VST",PXCECAT="CSTP":"VST",1:PXCECAT)
- S PXCECODE="PXCE"_$S(PXCECAT="IMM":"VIMM",1:PXCECAT)
- S PXCEAUPN=$P($T(FORMAT^@PXCECODE),"~",5)
- S PXCECATT=$P($P($T(FORMAT^@PXCECODE),";;",2),"~",1)
- S PXCEFILE=$P($T(FORMAT^@PXCECODE),"~",2)
- S (PXCEQUIT,PXVICR)=0
- I '$D(PXCAAFTR),PXCECAT'="SIT",PXCECAT'="APPM",PXCECAT'="HIST",PXCEFIEN'>0 D ASK^PXCEVFI2(PXCEVIEN,.PXCEFIEN,PXCEAUPN,PXCECATT,PXCECODE)
- Q:PXCEQUIT
- I PXVICR S PXCEFIEN="" D EN("ICR") Q ; PX*1*215
- I PXCECAT'="SIT",PXCECAT'="APPM",PXCECAT'="HIST" S PXCELOOP=+PXCEFIEN
- E S PXCELOOP=1,PXCEFIEN=PXCEVIEN
- I PXCECAT="CSTP" D
- . I $$VSTAPPT^PXUTL1(PXCEPAT,+^AUPNVSIT(PXCEVIEN,0),PXCEHLOC,PXCEVIEN) S PXCELOOP=0
- . E S PXCELOOP=1
- I $D(PXCAAFTR) S PXCELOOP=1
- F D DOONE Q:PXCELOOP
- K PXCEFIEN
- Q
- ;
- DOONE ;
- N PXCEAFTR,PXCEUP,PXCEVFIN,PXELAP
- D INIT
- ;Save the initial V-file contents.
- M PXCEVFIN=PXCEAFTR
- Q:PXCEQUIT
- DOONE2 ;
- K PXKERROR
- S PXCENOER=0
- I PXCECAT="IMM" S PXVNEWDA="" ; PX*1*210
- D EDIT^PXCEVFI1
- I 'PXCEQUIT,PXCECAT="SIT",$P($G(PXCEAFTR(0)),"^")]"",$P($G(PXCEAFTR(0)),"^",22)]"" D
- . 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
- .. S PXCEQUIT=1,$P(PXCEAFTR(0),"^")=""
- .. W !,$C(7),"Cannot create encounter for appointment date/time and clinic that was previously cancelled, NOTHING was STORED"
- .. D WAIT^PXCEHELP
- I ($P(PXCEAFTR(0),"^")]"") D
- . I PXCEQUIT D
- .. I 'PXCEFIEN,PXCECAT="CPT" D
- ... D REMOVE(^TMP("PXK",$J,PXCECAT,1,"IEN"))
- .. I 'PXCENOER D
- ... I PXCEFIEN>0 D
- .... D:PXCECAT="CPT" MODUPD
- .... W !,$C(7),"The last entry did not have all of the required data and NOTHING was CHANGED."
- ... E W !,$C(7),"The last entry did not have all of the required data and NOTHING was STORED."
- ... D WAIT^PXCEHELP
- . E D SAVE^PXCEVFI2
- I PXCECAT="IMM",$G(PXVNEWDA) D EVIS^PXCEVIS K PXVNEWDA ; PX*1*210
- D EXIT
- Q
- ;
- INIT ; -- init variables and list array
- N PXCENODS,PXCEFOR,PXCENODE
- K ^TMP("PXK",$J),PXCEAFTR
- S ^TMP("PXK",$J,"SOR")=PXCESOR
- S ^TMP("PXK",$J,"VST",1,"IEN")=PXCEVIEN
- I PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST") D
- . F PXCENODE=0,21,150,800,811,812 D
- .. S PXCEAFTR(PXCENODE)=$S(PXCEVIEN>0:$G(^AUPNVSIT(PXCEVIEN,PXCENODE)),1:"")
- .. S ^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE")=PXCEAFTR(PXCENODE)
- E D
- . F PXCENODE=0,21,150,800,811,812 D
- .. S ^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE")=$G(^AUPNVSIT(+PXCEVIEN,PXCENODE))
- .. S ^TMP("PXK",$J,"VST",1,PXCENODE,"AFTER")=^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE")
- . ;
- . S ^TMP("PXK",$J,PXCECATS,1,"IEN")=PXCEFIEN
- . S PXCENODS=$P($T(FORMAT^@PXCECODE),"~",3)
- . F PXCEFOR=1:1 S PXCENODE=$P(PXCENODS,",",PXCEFOR) Q:PXCENODE']"" D
- .. I PXCEFIEN>0 D
- ... I PXCECAT="CPT",PXCENODE=1 D
- .... ;Retrieve CPT Modifiers from multiple field
- .... S PXCESEQ=0
- .... F S PXCESEQ=$O(@(PXCEAUPN_"(PXCEFIEN,PXCENODE,PXCESEQ)")) Q:'PXCESEQ D
- ..... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,PXCESEQ,"BEFORE")=$G(@(PXCEAUPN_"(PXCEFIEN,PXCENODE,PXCESEQ,0)"))
- ..... S PXCEAFTR(PXCENODE,PXCESEQ)=^TMP("PXK",$J,PXCECATS,1,PXCENODE,PXCESEQ,"BEFORE")
- ... E D
- .... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")=$G(@(PXCEAUPN_"(PXCEFIEN,PXCENODE)"))
- .... S PXCEAFTR(PXCENODE)=^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")
- .. E D
- ... I PXCECAT="CPT",PXCENODE=1 D Q
- .... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,1,"BEFORE")=""
- ... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")=""
- ... S PXCEAFTR(PXCENODE)=^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")
- Q:PXCEQUIT
- ;
- I PXCEAUPN'="^AUPNVSIT" D
- . ;Set the Patient and Visit pointers in the V-File.
- . S:'$P(PXCEAFTR(0),"^",2) $P(PXCEAFTR(0),"^",2)=PXCEPAT
- . S:'$P(PXCEAFTR(0),"^",3) $P(PXCEAFTR(0),"^",3)=PXCEVIEN
- . I $P(PXCEAFTR(0),"^",1)="" D
- .. S:'$P(PXCEAFTR(812),"^",2) $P(PXCEAFTR(812),"^",2)=PXCEPKG
- .. S:'$P(PXCEAFTR(812),"^",3) $P(PXCEAFTR(812),"^",3)=PXCESOR
- E D
- . ;If new visit set package and source.
- . I $P(PXCEAFTR(0),"^",1)="" D
- .. S:'$P(PXCEAFTR(812),"^",2) $P(PXCEAFTR(812),"^",2)=PXCEPKG
- .. S:'$P(PXCEAFTR(812),"^",3) $P(PXCEAFTR(812),"^",3)=PXCESOR
- . ;Set the Patient in the Visit for new visit.
- . I $G(PXCEAPDT)>0 D
- .. S:'$P(PXCEAFTR(0),"^",1) $P(PXCEAFTR(0),"^",1)=PXCEAPDT
- .. I '$P(PXCEAFTR(0),"^",21) D
- ... ;Get the ELIGIBILITY for the appointment
- ... N PXCEELIG
- ... S PXCEELIG=$$ELIGIBIL^PXCEVSIT(PXCEPAT,PXCEHLOC,PXCEAPDT)
- ... S:PXCEELIG>0 $P(PXCEAFTR(0),"^",21)=PXCEELIG
- . S:'$P(PXCEAFTR(0),"^",5)&($G(PXCEPAT)>0) $P(PXCEAFTR(0),"^",5)=PXCEPAT
- . S:'$P(PXCEAFTR(0),"^",22)&($G(PXCEHLOC)>0) $P(PXCEAFTR(0),"^",22)=PXCEHLOC
- Q
- ;
- EXIT ; -- exit code
- I PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST") L:PXCEVIEN>0 -@(PXCEAUPN_"(PXCEVIEN)"):30
- E L:PXCEFIEN>0 -@(PXCEAUPN_"(PXCEFIEN)"):30
- S PXCEFIEN=""
- K ^TMP("PXK",$J)
- K PXCEAFTR
- S PXCEQUIT=0
- Q
- ;
- MODUPD ;Update the MODIFIER list for the currently edited CPT code when all
- ;the reqired data is not entered.
- ;
- N SQ,DA,DIC,DIK,X
- S SQ=""
- F S SQ=$O(PXCEAFTR(1,SQ)) Q:'SQ D
- .S DA(1)=PXCEFIEN,DA=SQ
- .S DIK="^AUPNVCPT("_DA(1)_","_1_","
- .D ^DIK
- F S SQ=$O(^TMP("PXK",$J,"CPT",1,1,SQ)) Q:'SQ D
- .S X=^TMP("PXK",$J,"CPT",1,1,SQ,"BEFORE")
- .Q:X']""
- .K DD,DO
- .S DA(1)=PXCEFIEN
- .S DIC="^AUPNVCPT("_DA(1)_","_1_","
- .S DIC(0)="L",DIC("P")=$P(^DD(9000010.18,1,0),"^",2)
- .D FILE^DICN
- Q
- ;
- REMOVE(DA) ;REMOVE INCOMPLETE CPT ENTRY
- N DIK
- S DIK="^AUPNVCPT("
- I $G(DA) D ^DIK ;PX*1*124
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCEVFIL 6664 printed Jan 18, 2025@03:29:24 Page 2
- 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
- +2 ;
- +3 QUIT
- EN(PXCECAT) ; -- main entry point for PXCE pxcecat EDIT
- +1 IF PXCECAT="SIT"!(PXCECAT="HIST")
- DO PATINFO^PXCEPAT(.PXCEPAT)
- if $DATA(DIRUT)
- QUIT
- +2 IF PXCECAT'="SIT"
- IF PXCECAT'="APPM"
- IF PXCECAT'="HIST"
- if '$DATA(PXCEFIEN)!'$DATA(PXCEVIEN)!'$DATA(PXCEPAT)
- QUIT
- +3 IF '$TEST
- if (PXCEVIEW["P"&'$DATA(PXCEPAT))!(PXCEVIEW["H"&'$DATA(PXCEHLOC))!("~H~P~"'[("~"_$PIECE(PXCEVIEW,"^")_"~"))
- QUIT
- +4 IF PXCECAT="CSTP"
- IF $LENGTH($TEXT(DATE^SCDXUTL))
- IF $$DATE^SCDXUTL(+$GET(^AUPNVSIT(PXCEVIEN,0)))
- WRITE !!,$CHAR(7),"Stop Codes can not be added to encounters after "_$$FMDATE^SCDXUTL
- QUIT
- +5 NEW PXCEQUIT
- +6 IF "~CPT~CSTP~"[PXCECAT
- Begin DoDot:1
- +7 SET PXCEQUIT=0
- +8 IF $PIECE($GET(^AUPNVSIT(PXCEVIEN,0)),"^",7)="E"
- Begin DoDot:2
- +9 IF PXCECAT="CSTP"
- WRITE !!,$CHAR(7),"Historical Encounters cannot have Stop Codes."
- DO WAIT^PXCEHELP
- SET PXCEQUIT=1
- QUIT
- End DoDot:2
- if $GET(PXCEQUIT)
- QUIT
- End DoDot:1
- if PXCEQUIT
- QUIT
- +10 KILL PXCEQUIT
- +11 DO FULL^VALM1
- +12 ;
- +13 NEW PXCEVFIL,PXCELOOP,PXCENOER
- +14 ; PX*1*215
- NEW PXCECODE,PXCEAUPN,PXCECATS,PXCECATT,PXCEFILE,PXVICR
- +15 NEW PXCEPSCC
- +16 SET PXCECATS=$SELECT(PXCECAT="SIT":"VST",PXCECAT="APPM":"VST",PXCECAT="HIST":"VST",PXCECAT="CSTP":"VST",1:PXCECAT)
- +17 SET PXCECODE="PXCE"_$SELECT(PXCECAT="IMM":"VIMM",1:PXCECAT)
- +18 SET PXCEAUPN=$PIECE($TEXT(FORMAT^@PXCECODE),"~",5)
- +19 SET PXCECATT=$PIECE($PIECE($TEXT(FORMAT^@PXCECODE),";;",2),"~",1)
- +20 SET PXCEFILE=$PIECE($TEXT(FORMAT^@PXCECODE),"~",2)
- +21 SET (PXCEQUIT,PXVICR)=0
- +22 IF '$DATA(PXCAAFTR)
- IF PXCECAT'="SIT"
- IF PXCECAT'="APPM"
- IF PXCECAT'="HIST"
- IF PXCEFIEN'>0
- DO ASK^PXCEVFI2(PXCEVIEN,.PXCEFIEN,PXCEAUPN,PXCECATT,PXCECODE)
- +23 if PXCEQUIT
- QUIT
- +24 ; PX*1*215
- IF PXVICR
- SET PXCEFIEN=""
- DO EN("ICR")
- QUIT
- +25 IF PXCECAT'="SIT"
- IF PXCECAT'="APPM"
- IF PXCECAT'="HIST"
- SET PXCELOOP=+PXCEFIEN
- +26 IF '$TEST
- SET PXCELOOP=1
- SET PXCEFIEN=PXCEVIEN
- +27 IF PXCECAT="CSTP"
- Begin DoDot:1
- +28 IF $$VSTAPPT^PXUTL1(PXCEPAT,+^AUPNVSIT(PXCEVIEN,0),PXCEHLOC,PXCEVIEN)
- SET PXCELOOP=0
- +29 IF '$TEST
- SET PXCELOOP=1
- End DoDot:1
- +30 IF $DATA(PXCAAFTR)
- SET PXCELOOP=1
- +31 FOR
- DO DOONE
- if PXCELOOP
- QUIT
- +32 KILL PXCEFIEN
- +33 QUIT
- +34 ;
- DOONE ;
- +1 NEW PXCEAFTR,PXCEUP,PXCEVFIN,PXELAP
- +2 DO INIT
- +3 ;Save the initial V-file contents.
- +4 MERGE PXCEVFIN=PXCEAFTR
- +5 if PXCEQUIT
- QUIT
- DOONE2 ;
- +1 KILL PXKERROR
- +2 SET PXCENOER=0
- +3 ; PX*1*210
- IF PXCECAT="IMM"
- SET PXVNEWDA=""
- +4 DO EDIT^PXCEVFI1
- +5 IF 'PXCEQUIT
- IF PXCECAT="SIT"
- IF $PIECE($GET(PXCEAFTR(0)),"^")]""
- IF $PIECE($GET(PXCEAFTR(0)),"^",22)]""
- Begin DoDot:1
- +6 IF $DATA(^DPT(DFN,"S",$PIECE(PXCEAFTR(0),"^"),0))
- IF $PIECE($GET(^DPT(DFN,"S",$PIECE(PXCEAFTR(0),"^"),0)),"^")=$PIECE(PXCEAFTR(0),"^",22)
- IF $PIECE(^DPT(DFN,"S",$PIECE(PXCEAFTR(0),"^"),0),"^",2)["C"
- Begin DoDot:2
- +7 SET PXCEQUIT=1
- SET $PIECE(PXCEAFTR(0),"^")=""
- +8 WRITE !,$CHAR(7),"Cannot create encounter for appointment date/time and clinic that was previously cancelled, NOTHING was STORED"
- +9 DO WAIT^PXCEHELP
- End DoDot:2
- End DoDot:1
- +10 IF ($PIECE(PXCEAFTR(0),"^")]"")
- Begin DoDot:1
- +11 IF PXCEQUIT
- Begin DoDot:2
- +12 IF 'PXCEFIEN
- IF PXCECAT="CPT"
- Begin DoDot:3
- +13 DO REMOVE(^TMP("PXK",$JOB,PXCECAT,1,"IEN"))
- End DoDot:3
- +14 IF 'PXCENOER
- Begin DoDot:3
- +15 IF PXCEFIEN>0
- Begin DoDot:4
- +16 if PXCECAT="CPT"
- DO MODUPD
- +17 WRITE !,$CHAR(7),"The last entry did not have all of the required data and NOTHING was CHANGED."
- End DoDot:4
- +18 IF '$TEST
- WRITE !,$CHAR(7),"The last entry did not have all of the required data and NOTHING was STORED."
- +19 DO WAIT^PXCEHELP
- End DoDot:3
- End DoDot:2
- +20 IF '$TEST
- DO SAVE^PXCEVFI2
- End DoDot:1
- +21 ; PX*1*210
- IF PXCECAT="IMM"
- IF $GET(PXVNEWDA)
- DO EVIS^PXCEVIS
- KILL PXVNEWDA
- +22 DO EXIT
- +23 QUIT
- +24 ;
- INIT ; -- init variables and list array
- +1 NEW PXCENODS,PXCEFOR,PXCENODE
- +2 KILL ^TMP("PXK",$JOB),PXCEAFTR
- +3 SET ^TMP("PXK",$JOB,"SOR")=PXCESOR
- +4 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=PXCEVIEN
- +5 IF PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST")
- Begin DoDot:1
- +6 FOR PXCENODE=0,21,150,800,811,812
- Begin DoDot:2
- +7 SET PXCEAFTR(PXCENODE)=$SELECT(PXCEVIEN>0:$GET(^AUPNVSIT(PXCEVIEN,PXCENODE)),1:"")
- +8 SET ^TMP("PXK",$JOB,"VST",1,PXCENODE,"BEFORE")=PXCEAFTR(PXCENODE)
- End DoDot:2
- End DoDot:1
- +9 IF '$TEST
- Begin DoDot:1
- +10 FOR PXCENODE=0,21,150,800,811,812
- Begin DoDot:2
- +11 SET ^TMP("PXK",$JOB,"VST",1,PXCENODE,"BEFORE")=$GET(^AUPNVSIT(+PXCEVIEN,PXCENODE))
- +12 SET ^TMP("PXK",$JOB,"VST",1,PXCENODE,"AFTER")=^TMP("PXK",$JOB,"VST",1,PXCENODE,"BEFORE")
- End DoDot:2
- +13 ;
- +14 SET ^TMP("PXK",$JOB,PXCECATS,1,"IEN")=PXCEFIEN
- +15 SET PXCENODS=$PIECE($TEXT(FORMAT^@PXCECODE),"~",3)
- +16 FOR PXCEFOR=1:1
- SET PXCENODE=$PIECE(PXCENODS,",",PXCEFOR)
- if PXCENODE']""
- QUIT
- Begin DoDot:2
- +17 IF PXCEFIEN>0
- Begin DoDot:3
- +18 IF PXCECAT="CPT"
- IF PXCENODE=1
- Begin DoDot:4
- +19 ;Retrieve CPT Modifiers from multiple field
- +20 SET PXCESEQ=0
- +21 FOR
- SET PXCESEQ=$ORDER(@(PXCEAUPN_"(PXCEFIEN,PXCENODE,PXCESEQ)"))
- if 'PXCESEQ
- QUIT
- Begin DoDot:5
- +22 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,PXCESEQ,"BEFORE")=$GET(@(PXCEAUPN_"(PXCEFIEN,PXCENODE,PXCESEQ,0)"))
- +23 SET PXCEAFTR(PXCENODE,PXCESEQ)=^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,PXCESEQ,"BEFORE")
- End DoDot:5
- End DoDot:4
- +24 IF '$TEST
- Begin DoDot:4
- +25 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"BEFORE")=$GET(@(PXCEAUPN_"(PXCEFIEN,PXCENODE)"))
- +26 SET PXCEAFTR(PXCENODE)=^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"BEFORE")
- End DoDot:4
- End DoDot:3
- +27 IF '$TEST
- Begin DoDot:3
- +28 IF PXCECAT="CPT"
- IF PXCENODE=1
- Begin DoDot:4
- +29 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,1,"BEFORE")=""
- End DoDot:4
- QUIT
- +30 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"BEFORE")=""
- +31 SET PXCEAFTR(PXCENODE)=^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"BEFORE")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +32 if PXCEQUIT
- QUIT
- +33 ;
- +34 IF PXCEAUPN'="^AUPNVSIT"
- Begin DoDot:1
- +35 ;Set the Patient and Visit pointers in the V-File.
- +36 if '$PIECE(PXCEAFTR(0),"^",2)
- SET $PIECE(PXCEAFTR(0),"^",2)=PXCEPAT
- +37 if '$PIECE(PXCEAFTR(0),"^",3)
- SET $PIECE(PXCEAFTR(0),"^",3)=PXCEVIEN
- +38 IF $PIECE(PXCEAFTR(0),"^",1)=""
- Begin DoDot:2
- +39 if '$PIECE(PXCEAFTR(812),"^",2)
- SET $PIECE(PXCEAFTR(812),"^",2)=PXCEPKG
- +40 if '$PIECE(PXCEAFTR(812),"^",3)
- SET $PIECE(PXCEAFTR(812),"^",3)=PXCESOR
- End DoDot:2
- End DoDot:1
- +41 IF '$TEST
- Begin DoDot:1
- +42 ;If new visit set package and source.
- +43 IF $PIECE(PXCEAFTR(0),"^",1)=""
- Begin DoDot:2
- +44 if '$PIECE(PXCEAFTR(812),"^",2)
- SET $PIECE(PXCEAFTR(812),"^",2)=PXCEPKG
- +45 if '$PIECE(PXCEAFTR(812),"^",3)
- SET $PIECE(PXCEAFTR(812),"^",3)=PXCESOR
- End DoDot:2
- +46 ;Set the Patient in the Visit for new visit.
- +47 IF $GET(PXCEAPDT)>0
- Begin DoDot:2
- +48 if '$PIECE(PXCEAFTR(0),"^",1)
- SET $PIECE(PXCEAFTR(0),"^",1)=PXCEAPDT
- +49 IF '$PIECE(PXCEAFTR(0),"^",21)
- Begin DoDot:3
- +50 ;Get the ELIGIBILITY for the appointment
- +51 NEW PXCEELIG
- +52 SET PXCEELIG=$$ELIGIBIL^PXCEVSIT(PXCEPAT,PXCEHLOC,PXCEAPDT)
- +53 if PXCEELIG>0
- SET $PIECE(PXCEAFTR(0),"^",21)=PXCEELIG
- End DoDot:3
- End DoDot:2
- +54 if '$PIECE(PXCEAFTR(0),"^",5)&($GET(PXCEPAT)>0)
- SET $PIECE(PXCEAFTR(0),"^",5)=PXCEPAT
- +55 if '$PIECE(PXCEAFTR(0),"^",22)&($GET(PXCEHLOC)>0)
- SET $PIECE(PXCEAFTR(0),"^",22)=PXCEHLOC
- End DoDot:1
- +56 QUIT
- +57 ;
- EXIT ; -- exit code
- +1 IF PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST")
- if PXCEVIEN>0
- LOCK -@(PXCEAUPN_"(PXCEVIEN)"):30
- +2 IF '$TEST
- if PXCEFIEN>0
- LOCK -@(PXCEAUPN_"(PXCEFIEN)"):30
- +3 SET PXCEFIEN=""
- +4 KILL ^TMP("PXK",$JOB)
- +5 KILL PXCEAFTR
- +6 SET PXCEQUIT=0
- +7 QUIT
- +8 ;
- MODUPD ;Update the MODIFIER list for the currently edited CPT code when all
- +1 ;the reqired data is not entered.
- +2 ;
- +3 NEW SQ,DA,DIC,DIK,X
- +4 SET SQ=""
- +5 FOR
- SET SQ=$ORDER(PXCEAFTR(1,SQ))
- if 'SQ
- QUIT
- Begin DoDot:1
- +6 SET DA(1)=PXCEFIEN
- SET DA=SQ
- +7 SET DIK="^AUPNVCPT("_DA(1)_","_1_","
- +8 DO ^DIK
- End DoDot:1
- +9 FOR
- SET SQ=$ORDER(^TMP("PXK",$JOB,"CPT",1,1,SQ))
- if 'SQ
- QUIT
- Begin DoDot:1
- +10 SET X=^TMP("PXK",$JOB,"CPT",1,1,SQ,"BEFORE")
- +11 if X']""
- QUIT
- +12 KILL DD,DO
- +13 SET DA(1)=PXCEFIEN
- +14 SET DIC="^AUPNVCPT("_DA(1)_","_1_","
- +15 SET DIC(0)="L"
- SET DIC("P")=$PIECE(^DD(9000010.18,1,0),"^",2)
- +16 DO FILE^DICN
- End DoDot:1
- +17 QUIT
- +18 ;
- REMOVE(DA) ;REMOVE INCOMPLETE CPT ENTRY
- +1 NEW DIK
- +2 SET DIK="^AUPNVCPT("
- +3 ;PX*1*124
- IF $GET(DA)
- DO ^DIK
- +4 QUIT