PXCEVFI2 ;ISL/dee,ESW - Supporting routines for editing a visit or v-file entry ; 11/6/02 2:36pm
;;1.0;PCE PATIENT CARE ENCOUNTER;**22,73,95,96**;Aug 12, 1996
;; ;
Q
ASK(PXCVIEN,PXCFIEN,PXCEAUPN,PXCCATT,PXCCODE) ; -- Display a selection list from one V-File for this visit
N PXCEINDX,PXCECNT,PXCEASK,PXCEREF
N DIR,DA,X,Y
S PXCEINDX=""
F PXCECNT=0:1 S PXCEINDX=$O(@(PXCEAUPN_"(""AD"",PXCVIEN,PXCEINDX)")) Q:'PXCEINDX D
. W:PXCECNT=0 !!,"--- "_PXCCATT_" ---",!
. S PXCEASK(PXCECNT+1)=PXCEINDX
. W !,$J(PXCECNT+1,3),?6,@("$$DISPLY01^"_PXCCODE_"("_PXCEAUPN_"(PXCEINDX,0))")
Q:PXCECNT'>0
ASKLOOP S DIR(0)="FAO^1:"_$L(PXCECNT)
S DIR("A")="Enter 1-"_PXCECNT_" to Edit, or 'A' to Add: "
S DIR("?")="Enter the number of the "_PXCCATT_" you wish to edit or A to add a new "_PXCCATT_"."
D ^DIR
K DIR,DA
I $D(DIRUT) S PXCEQUIT=1 Q
Q:"Aa"[Y
G:Y<1!(Y>PXCECNT) ASKLOOP
G:$G(PXCEASK(Y))'>0 ASKLOOP
S PXCFIEN=$G(PXCEASK(Y))
Q
;
SAVE ; -- Save this edited and quit editing.
I PXCECAT="CSTP" S PXCEFIEN=$$STOPCODE^PXUTLSTP(PXCESOR,$P(PXCEAFTR(0),"^",8),PXCEVIEN)
E D
. N PXCENODS,PXCEFOR,PXCENODE,PXCESEQ
. S PXCENODS=$P($T(FORMAT^@PXCECODE),"~",3)
. F PXCEFOR=1:1 S PXCENODE=$P(PXCENODS,",",PXCEFOR) Q:PXCENODE']"" D
.. I PXCENODE=1,PXCECATS="CPT" D Q
... S PXCESEQ=""
... F S PXCESEQ=$O(PXCEAFTR(PXCENODE,PXCESEQ)) Q:PXCESEQ="" D
.... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,PXCESEQ,"AFTER")=PXCEAFTR(PXCENODE,PXCESEQ)
.. S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"AFTER")=PXCEAFTR(PXCENODE)
. I PXCECAT="SK",^TMP("PXK",$J,PXCECATS,1,"IEN")]"" D SAVE^PXCESK
. D EN1^PXKMAIN
. I PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST") S PXCEVIEN=^TMP("PXK",$J,"VST",1,"IEN")
Q
;
DEL(PXCECAT) ; -- Delete this V-File entry from the List if all the visit infomation.
I PXCEFIEN'>0!(PXCEVIEN'>0) W !!,$C(7),"Error: Cannot delete this an unknown V-File entry." D PAUSE^PXCEHELP Q
I PXCEKEYS'["D",PXCEKEYS'["d" W !!,$C(7),"Error: You do not have delete access." D PAUSE^PXCEHELP Q
;
N PXCENODS,PXCEFOR,PXCENODE,PXCECATS,PXCECATT,PXCECODE,PXCEAUPN,PXCEQUIT
S PXCECODE="PXCE"_$S(PXCECAT="IMM":"VIMM",1:PXCECAT)
S PXCECATS=$S(PXCECAT="CSTP":"VST",PXCECAT="HIST":"VST",1:PXCECAT)
S PXCEAUPN=$P($T(FORMAT^@PXCECODE),"~",5)
S PXCECATT=$P($P($T(FORMAT^@PXCECODE),";;",2),"~",1)
;
I '$D(@(PXCEAUPN_"(PXCEFIEN)")) Q
I $P($G(@(PXCEAUPN_"(PXCEFIEN,812)")),"^",1) D Q
. W !!,"Error on deleting "_PXCECATT_" ",@("$$DISPLY01^"_PXCECODE_"(@(PXCEAUPN_""(PXCEFIEN,0)""))")
. W !,"Error: You cannot delete this entry it has been ""Verified""." D WAIT^PXCEHELP
I PXCEKEYS'["D" D Q:PXCEQUIT
. N PXCECHK
. S PXCEQUIT=0
. I PXCECATS="VST" S PXCECHK=$P($G(@(PXCEAUPN_"(PXCEFIEN,0)")),"^",23)
. E S PXCECHK=$P($P($P($G(@(PXCEAUPN_"(PXCEFIEN,801)")),"^",2),";",1)," ",2)
. I DUZ'=PXCECHK D
.. S PXCEQUIT=1
.. N NODE0
.. S NODE0=@(PXCEAUPN_"(PXCEFIEN,0)")
.. W !!,"Error on deleting "_PXCECATT_" ",@("$$DISPLY01^"_PXCECODE_"(NODE0)")
.. W !,"Error: You cannot delete an entry you did not create." D WAIT^PXCEHELP
;
I PXCECAT="CSTP" D
. W !!,"Deleting "_PXCECATT_" "
. W @("$$DISPLY01^"_PXCECODE_"($G(@(PXCEAUPN_""(PXCEFIEN,0)"")))")
. Q:'$$SURE^PXCEAE2
. N PXCERESU
. S PXCERESU=$$STOPCODE^PXUTLSTP(PXCESOR,"@",PXCEVIEN,PXCEFIEN)
. S:$D(PXCELOOP) PXCELOOP=1
E I PXCECATS="VST" D
. W !!,"Deleting "_PXCECATT_" "
. W @("$$DISPLY01^"_PXCECODE_"($G(@(PXCEAUPN_""(PXCEFIEN,0)"")))")
. Q:'$$SURE^PXCEAE2
. N PXCERESU
. S PXCERESU=$$KILL^VSITKIL(PXCEVIEN)
. I PXCERESU D
.. I PXCERESU=1,$O(^SCE("AVSIT",PXCEVIEN,"")) Q
.. W !,$C(7),"Could not delete the encounter. There are still users of it." D WAIT^PXCEHELP
. I 'PXCERESU S PXCEVDEL=1 S:$D(PXCELOOP) (PXCELOOP,PXCEQUIT,PXCENOER)=1
. D EVENT^PXKMAIN
;
E D
. K ^TMP("PXK",$J)
. S ^TMP("PXK",$J,"VST",1,"IEN")=PXCEVIEN
. F PXCENODE=0,21,150,800,811,812 D
.. S (^TMP("PXK",$J,"VST",1,PXCENODE,"AFTER"),^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE"))=$G(^AUPNVSIT(PXCEVIEN,PXCENODE))
. ;
. S ^TMP("PXK",$J,"SOR")=PXCESOR
. 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
.. S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")=$G(@(PXCEAUPN_"(PXCEFIEN,PXCENODE)"))
. ;
. N DIK,DA
. W !!,"Deleting "_PXCECATT_" "
. W @("$$DISPLY01^"_PXCECODE_"(^TMP(""PXK"",$J,PXCECATS,1,0,""BEFORE""))")
. Q:'$$SURE^PXCEAE2 ;DELQUIT
. S PXCENODS=$P($T(FORMAT^@PXCECODE),"~",3)
. F PXCEFOR=1:1 S PXCENODE=$P(PXCENODS,",",PXCEFOR) Q:PXCENODE']"" S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"AFTER")=$S(PXCENODE=0:"@",1:"")
. D EN1^PXKMAIN
. S:$D(PXCELOOP) PXCELOOP=1
. I $D(PXCENOER)#2 S PXCENOER=1
;
DELQUIT ;
K ^TMP("PXK",$J)
Q
;
PXCEVFI2 ;ISL/dee,ESW - Supporting routines for editing a visit or v-file entry ; 11/6/02 2:36pm
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,73,95,96**;Aug 12, 1996
+2 ;; ;
+3 QUIT
ASK(PXCVIEN,PXCFIEN,PXCEAUPN,PXCCATT,PXCCODE) ; -- Display a selection list from one V-File for this visit
+1 NEW PXCEINDX,PXCECNT,PXCEASK,PXCEREF
+2 NEW DIR,DA,X,Y
+3 SET PXCEINDX=""
+4 FOR PXCECNT=0:1
SET PXCEINDX=$ORDER(@(PXCEAUPN_"(""AD"",PXCVIEN,PXCEINDX)"))
IF 'PXCEINDX
QUIT
Begin DoDot:1
+5 IF PXCECNT=0
WRITE !!,"--- "_PXCCATT_" ---",!
+6 SET PXCEASK(PXCECNT+1)=PXCEINDX
+7 WRITE !,$JUSTIFY(PXCECNT+1,3),?6,@("$$DISPLY01^"_PXCCODE_"("_PXCEAUPN_"(PXCEINDX,0))")
End DoDot:1
+8 IF PXCECNT'>0
QUIT
ASKLOOP SET DIR(0)="FAO^1:"_$LENGTH(PXCECNT)
+1 SET DIR("A")="Enter 1-"_PXCECNT_" to Edit, or 'A' to Add: "
+2 SET DIR("?")="Enter the number of the "_PXCCATT_" you wish to edit or A to add a new "_PXCCATT_"."
+3 DO ^DIR
+4 KILL DIR,DA
+5 IF $DATA(DIRUT)
SET PXCEQUIT=1
QUIT
+6 IF "Aa"[Y
QUIT
+7 IF Y<1!(Y>PXCECNT)
GOTO ASKLOOP
+8 IF $GET(PXCEASK(Y))'>0
GOTO ASKLOOP
+9 SET PXCFIEN=$GET(PXCEASK(Y))
+10 QUIT
+11 ;
SAVE ; -- Save this edited and quit editing.
+1 IF PXCECAT="CSTP"
SET PXCEFIEN=$$STOPCODE^PXUTLSTP(PXCESOR,$PIECE(PXCEAFTR(0),"^",8),PXCEVIEN)
+2 IF '$TEST
Begin DoDot:1
+3 NEW PXCENODS,PXCEFOR,PXCENODE,PXCESEQ
+4 SET PXCENODS=$PIECE($TEXT(FORMAT^@PXCECODE),"~",3)
+5 FOR PXCEFOR=1:1
SET PXCENODE=$PIECE(PXCENODS,",",PXCEFOR)
IF PXCENODE']""
QUIT
Begin DoDot:2
+6 IF PXCENODE=1
IF PXCECATS="CPT"
Begin DoDot:3
+7 SET PXCESEQ=""
+8 FOR
SET PXCESEQ=$ORDER(PXCEAFTR(PXCENODE,PXCESEQ))
IF PXCESEQ=""
QUIT
Begin DoDot:4
+9 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,PXCESEQ,"AFTER")=PXCEAFTR(PXCENODE,PXCESEQ)
End DoDot:4
End DoDot:3
QUIT
+10 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"AFTER")=PXCEAFTR(PXCENODE)
End DoDot:2
+11 IF PXCECAT="SK"
IF ^TMP("PXK",$JOB,PXCECATS,1,"IEN")]""
DO SAVE^PXCESK
+12 DO EN1^PXKMAIN
+13 IF PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST")
SET PXCEVIEN=^TMP("PXK",$JOB,"VST",1,"IEN")
End DoDot:1
+14 QUIT
+15 ;
DEL(PXCECAT) ; -- Delete this V-File entry from the List if all the visit infomation.
+1 IF PXCEFIEN'>0!(PXCEVIEN'>0)
WRITE !!,$CHAR(7),"Error: Cannot delete this an unknown V-File entry."
DO PAUSE^PXCEHELP
QUIT
+2 IF PXCEKEYS'["D"
IF PXCEKEYS'["d"
WRITE !!,$CHAR(7),"Error: You do not have delete access."
DO PAUSE^PXCEHELP
QUIT
+3 ;
+4 NEW PXCENODS,PXCEFOR,PXCENODE,PXCECATS,PXCECATT,PXCECODE,PXCEAUPN,PXCEQUIT
+5 SET PXCECODE="PXCE"_$SELECT(PXCECAT="IMM":"VIMM",1:PXCECAT)
+6 SET PXCECATS=$SELECT(PXCECAT="CSTP":"VST",PXCECAT="HIST":"VST",1:PXCECAT)
+7 SET PXCEAUPN=$PIECE($TEXT(FORMAT^@PXCECODE),"~",5)
+8 SET PXCECATT=$PIECE($PIECE($TEXT(FORMAT^@PXCECODE),";;",2),"~",1)
+9 ;
+10 IF '$DATA(@(PXCEAUPN_"(PXCEFIEN)"))
QUIT
+11 IF $PIECE($GET(@(PXCEAUPN_"(PXCEFIEN,812)")),"^",1)
Begin DoDot:1
+12 WRITE !!,"Error on deleting "_PXCECATT_" ",@("$$DISPLY01^"_PXCECODE_"(@(PXCEAUPN_""(PXCEFIEN,0)""))")
+13 WRITE !,"Error: You cannot delete this entry it has been ""Verified""."
DO WAIT^PXCEHELP
End DoDot:1
QUIT
+14 IF PXCEKEYS'["D"
Begin DoDot:1
+15 NEW PXCECHK
+16 SET PXCEQUIT=0
+17 IF PXCECATS="VST"
SET PXCECHK=$PIECE($GET(@(PXCEAUPN_"(PXCEFIEN,0)")),"^",23)
+18 IF '$TEST
SET PXCECHK=$PIECE($PIECE($PIECE($GET(@(PXCEAUPN_"(PXCEFIEN,801)")),"^",2),";",1)," ",2)
+19 IF DUZ'=PXCECHK
Begin DoDot:2
+20 SET PXCEQUIT=1
+21 NEW NODE0
+22 SET NODE0=@(PXCEAUPN_"(PXCEFIEN,0)")
+23 WRITE !!,"Error on deleting "_PXCECATT_" ",@("$$DISPLY01^"_PXCECODE_"(NODE0)")
+24 WRITE !,"Error: You cannot delete an entry you did not create."
DO WAIT^PXCEHELP
End DoDot:2
End DoDot:1
IF PXCEQUIT
QUIT
+25 ;
+26 IF PXCECAT="CSTP"
Begin DoDot:1
+27 WRITE !!,"Deleting "_PXCECATT_" "
+28 WRITE @("$$DISPLY01^"_PXCECODE_"($G(@(PXCEAUPN_""(PXCEFIEN,0)"")))")
+29 IF '$$SURE^PXCEAE2
QUIT
+30 NEW PXCERESU
+31 SET PXCERESU=$$STOPCODE^PXUTLSTP(PXCESOR,"@",PXCEVIEN,PXCEFIEN)
+32 IF $DATA(PXCELOOP)
SET PXCELOOP=1
End DoDot:1
+33 IF '$TEST
IF PXCECATS="VST"
Begin DoDot:1
+34 WRITE !!,"Deleting "_PXCECATT_" "
+35 WRITE @("$$DISPLY01^"_PXCECODE_"($G(@(PXCEAUPN_""(PXCEFIEN,0)"")))")
+36 IF '$$SURE^PXCEAE2
QUIT
+37 NEW PXCERESU
+38 SET PXCERESU=$$KILL^VSITKIL(PXCEVIEN)
+39 IF PXCERESU
Begin DoDot:2
+40 IF PXCERESU=1
IF $ORDER(^SCE("AVSIT",PXCEVIEN,""))
QUIT
+41 WRITE !,$CHAR(7),"Could not delete the encounter. There are still users of it."
DO WAIT^PXCEHELP
End DoDot:2
+42 IF 'PXCERESU
SET PXCEVDEL=1
IF $DATA(PXCELOOP)
SET (PXCELOOP,PXCEQUIT,PXCENOER)=1
+43 DO EVENT^PXKMAIN
End DoDot:1
+44 ;
+45 IF '$TEST
Begin DoDot:1
+46 KILL ^TMP("PXK",$JOB)
+47 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=PXCEVIEN
+48 FOR PXCENODE=0,21,150,800,811,812
Begin DoDot:2
+49 SET (^TMP("PXK",$JOB,"VST",1,PXCENODE,"AFTER"),^TMP("PXK",$JOB,"VST",1,PXCENODE,"BEFORE"))=$GET(^AUPNVSIT(PXCEVIEN,PXCENODE))
End DoDot:2
+50 ;
+51 SET ^TMP("PXK",$JOB,"SOR")=PXCESOR
+52 SET ^TMP("PXK",$JOB,PXCECATS,1,"IEN")=PXCEFIEN
+53 ;
+54 SET PXCENODS=$PIECE($TEXT(FORMAT^@PXCECODE),"~",3)
+55 FOR PXCEFOR=1:1
SET PXCENODE=$PIECE(PXCENODS,",",PXCEFOR)
IF PXCENODE']""
QUIT
Begin DoDot:2
+56 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"BEFORE")=$GET(@(PXCEAUPN_"(PXCEFIEN,PXCENODE)"))
End DoDot:2
+57 ;
+58 NEW DIK,DA
+59 WRITE !!,"Deleting "_PXCECATT_" "
+60 WRITE @("$$DISPLY01^"_PXCECODE_"(^TMP(""PXK"",$J,PXCECATS,1,0,""BEFORE""))")
+61 ;DELQUIT
IF '$$SURE^PXCEAE2
QUIT
+62 SET PXCENODS=$PIECE($TEXT(FORMAT^@PXCECODE),"~",3)
+63 FOR PXCEFOR=1:1
SET PXCENODE=$PIECE(PXCENODS,",",PXCEFOR)
IF PXCENODE']""
QUIT
SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"AFTER")=$SELECT(PXCENODE=0:"@",1:"")
+64 DO EN1^PXKMAIN
+65 IF $DATA(PXCELOOP)
SET PXCELOOP=1
+66 IF $DATA(PXCENOER)#2
SET PXCENOER=1
End DoDot:1
+67 ;
DELQUIT ;
+1 KILL ^TMP("PXK",$JOB)
+2 QUIT
+3 ;
