PXKMAIN ;ISL/JVS,PKR,ISA/Zoltan - Main Routine for Data Capture ;03/12/2020
;;1.0;PCE PATIENT CARE ENCOUNTER;**22,59,73,88,69,117,130,124,174,164,210,215,216,211**;Aug 12, 1996;Build 454
;+This routine is responsible for:
;+
;+LOCAL VARIABLE LIST:
;+ PXFG = Stop flag with duplicate of delete
;+ PXKAFT = After node
;+ PXKBEF = Before node
;+ PXKAV = Pieces from the after node
;+ PXKBV = Pieces from the before node
;+ PXKERROR = Set when there is an error
;+ PXKFGAD = ADD flag
;+ PXKFGED = EDIT flag
;+ PXKFGDE = DELETE flag
;+ PXKSEQ = Sequence number in PXK TMP global
;+ PXKCAT = Category of entry (CPT,MSR,VST...)
;+ PXKREF = Root of temp global
;+ PXKPIEN = IEN of v file or the visit file
;+ PXKREF = The original reference we are ordering off of
;+ PXKRT = name of the node in the v file
;+ PXKRTN = routine name for the file routine
;+ PXKSOR = the data source for this entry
;+ PXKSUB = the subscript the data is located on the v file
;+ PXKVST = the visit IEN
;+ PXKDUZ = the DUZ of the user
;+ *PXKHLR* = A variable set by calling routine so that duplicate
;+ PXKERROR messages aren't produced.
;
W !,"This is not an entry point" Q
EN1 ;+Main entry point to read ^TMP("PXK", Global
;+ Partial ^TMP Global Structure when called:
;+ ^TMP("PXK",$J,"SOR") = Source ien
;+
;+ ^TMP("PXK",$J,"VST",1,0,"BEFORE") = the 0-node of the visit file
;+ ^TMP("PXK",$J,"VST",1,0,"AFTER") = 0-node after changes.
;+ ^TMP("PXK",$J,"VST",provider counter,"IEN") = ""
;+
;+ ^TMP("PXK",$J,"PRV",provider counter,0,"BEFORE") = ""
;+ ^TMP("PXK",$J,"PRV",provider counter,0,"AFTER") = Provider id^DFN^Visitien^'P' or 'S' for primary/secondary
;+ ^TMP("PXK",$J,"PRV",provider counter,"IEN") = ""
;+ ^TMP("PXK",$J,"PRV",provider counter,"BEFORE") = ""
;+ ^TMP("PXK",$J,"PRV",provider counter,"AFTER") = ^Package ien^Source ien
;+
N LOCK,PXKDUZ,VISITIEN
K PXKERROR
I '$G(PXKDUZ) S PXKDUZ=$S($G(DUZ):DUZ,1:.5)
D VST(.VISITIEN,PXKDUZ,.LOCK)
I LOCK=0 S PXAERRF=4 Q
I VISITIEN>0 D UNLOCK^PXLOCK(VISITIEN,PXKDUZ)
Q
;
;VST ;--Check for visit node and get one created or quit.
VST(VISITIEN,PXKDUZ,LOCK) ;--Check for visit node and get one created or quit.
S LOCK=0,VISITIEN=""
I '$G(^TMP("PXK",$J,"VST",1,"IEN")) D VSIT^PXKVST
I +$G(^TMP("PXK",$J,"VST",1,"IEN"))=-1 S PXKERROR("VISIT")="Visit Tracking could not get a visit." Q
I +$G(^TMP("PXK",$J,"VST",1,"IEN"))=-2 S PXKERROR("VISIT")="PCE is not activated in Visit Tracking Parameters and thus cannot create visits." Q
I +$G(^TMP("PXK",$J,"VST",1,"IEN"))<1 S PXKERROR("VISIT")="Did not get a visit^"_$G(^TMP("PXK",$J,"VST",1,"IEN")) Q
S VISITIEN=^TMP("PXK",$J,"VST",1,"IEN")
S LOCK=$$LOCK^PXLOCK(VISITIEN,PXKDUZ,2,.PXKERROR)
I LOCK=0 Q
;
NEW ;--New variables and set main variables
N PXKDFN,PXKSOR,PXKVST,PXKSEQ,PXFG,PXKAFT,PXKBEF,PXKAUDIT
N PXKCAT,PXKCO,PXKER,PXKFGAD,PXKFGED,PXKFGDE,PXKNOD,PXKPCE
N PXKPIEN,PXKREF,PXKRTN,PXKSORR,PXKSUB,PXKVCAT
N PXKPTR,PXDFG,PX,PXJJ,PXJJJ,PXKAFT8,PXKAFTR,PXKGN,PXKN,PXKNOW,PXKP
N PXKRRT,PXKVRTN,PXKRT,PXKFVDLM,TMPPX
PRVTYPE ;---DO PROVIDER TYPE--PXKMAIN2
D PRVTYPE^PXKMAIN2
;
SET ;--SET VARIABLES NECESSARY
;'DA' should not be defined at this point
N DA ;PX*1.0*117
;
S PXFG=0,TMPPX="^",PXKLAYGO="",PXDFG=0
SOURCE S PXKSOR=$G(^TMP("PXK",$J,"SOR")) D Q:$D(PXKERROR("SOURCE"))
.S PXKCO("SOR")=PXKSOR
.I $D(PXKSOR)']"" S PXKERROR("SOURCE")="" Q
VISIT S (PXKVST,VSIT("IEN"))=$G(^TMP("PXK",$J,"VST",1,"IEN"))
ORDER ;--$ORDER Through the ^TMP("PXK", global setting variables
S PXKREF="^TMP(""PXK"",$J)"
CATEG S PXKCAT="" F S (PXKCAT,PXKVCAT)=$O(@PXKREF@(PXKCAT)) Q:PXKCAT="" D
.I PXKCAT="VST" S PXKVCAT="SIT"
.S PXKRTN="PXKF"_PXKCAT
.S X=PXKRTN X ^%ZOSF("TEST") Q:'$T
SEQUE .S PXKSEQ=0 F S PXKSEQ=$O(@PXKREF@(PXKCAT,PXKSEQ)) K PXKAV,PXKBV S PXFG=0 Q:'PXKSEQ D
..S PXKPIEN=$G(@PXKREF@(PXKCAT,PXKSEQ,"IEN")),(PXKFGAD,PXKFGDE,PXKFGED,PXDFG)=0
SUBSCR ..S PXKSUB="" F S PXKSUB=$O(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB)) Q:PXKSUB["IEN" Q:PXFG=1 Q:PXDFG=1 D
AFTER ...S PXKAFT(PXKSUB)=$G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,"AFTER"))
BEFORE ...S PXKBEF(PXKSUB)=$G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,"BEFORE"))
...I PXKCAT="CPT",PXKSUB=1 D SUBSCR^PXKMOD
...I PXKCAT="IMM",PXKSUB?1(1"2",1"3",1"11") D MULT
...D LOOP^PXKMAIN1 I PXKSUB=0 D ERROR^PXKMAIN1
...S PXDFG=0 I $G(PXKAV(0,1))["@"!('$D(PXKAV(0,1))) S PXKAFT(PXKSUB)="" K PXKAV(0) S PXDFG=1
..Q:PXFG=1
..I $D(PXKAV),'$D(PXKBV) S PXKSORR=PXKSOR_"-A "_PXKDUZ,PXKFGAD=1 I PXKCAT["VST" S PXKFGAD=0
..I '$D(PXKAV),$D(PXKBV) S PXKFGDE=1,PXKFVDLM="" D
...S PXKRT=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")" I $D(@PXKRT) D CHKAUD,DELETE^PXKMAIN1,EN1^PXKMASC S PXFG=1 K PXKRT Q
..I 'PXKFGAD,'PXKFGDE D
...I PXKCAT="VST" D CQDEL
...D CLEAN^PXKMAIN1
...I $D(PXKAV) S PXKSORR=PXKSOR_"-E "_PXKDUZ,PXKFGED=1 I PXKCAT="VST",'$D(PXKBV),$D(PXKVST) S PXKFGED=0
..I 'PXKFGAD,'PXKFGDE,'PXKFGED,PXKCAT["VST" D EN1^PXKMASC
..I PXKFGAD=1 D Q:PXFG
...D ERROR^PXKMAIN1
...I $D(PXKERROR(PXKCAT,PXKSEQ)) S PXFG=1
...D:'PXFG DUP^PXKMAIN1
...I PXFG=1 D Q
....Q:PXKCAT'="CPT"
....I $G(@PXKREF@(PXKCAT,PXKSEQ,"IEN"))]"" D REMOVE^PXCEVFIL(@PXKREF@(PXKCAT,PXKSEQ,"IEN"))
...;FILE^PXKMAIN1 MAKES THE ENTRY
...D:'PXKPIEN FILE^PXKMAIN1
...S:'$G(DA) DA=PXKPIEN
...D AUD2^PXKMAIN1,DRDIE^PXKMAIN1,EN1^PXKMASC
..I PXKFGED=1,PXKCAT'="VST" S PXKRT=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")" Q:'$D(@PXKRT) S DA=PXKPIEN D DUP^PXKMAIN1 Q:PXFG=1 D AUD12^PXKMAIN1,CHKAUD,DRDIE^PXKMAIN1,EN1^PXKMASC
..I PXKFGED=1,PXKCAT="VST" S PXKRT=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")" Q:'$D(@PXKRT) S DA=PXKPIEN D DUP^PXKMAIN1 Q:PXFG=1 D DRDIE^PXKMAIN1,EN1^PXKMASC
..D SPEC2^PXKMAIN2
..D EN^PXKMCODE
..K PXKAFT,PXKBEF
I $D(^TMP("PXKSAVE",$J)) D RECALL^PXKMAIN2
D EXIT
Q
;
MULT ; Add multiples to PXKAFT, PXKBEF, PXKAV, PXKBV arrays
;
N PXKSUBIEN,PXKI
;
S PXKSUBIEN=0
F S PXKSUBIEN=$O(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKSUBIEN)) Q:'PXKSUBIEN D
. ;
. I $D(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKSUBIEN,"AFTER")) D
. . S PXKAFT(PXKSUB,PXKSUBIEN)=$G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKSUBIEN,"AFTER"))
. . F PXKI=1:1:$L(PXKAFT(PXKSUB,PXKSUBIEN),"^") D
. . . I $P(PXKAFT(PXKSUB,PXKSUBIEN),"^",PXKI)'="" S PXKAV(PXKSUB,PXKSUBIEN,PXKI)=$P(PXKAFT(PXKSUB,PXKSUBIEN),"^",PXKI)
. ;
. I $D(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKSUBIEN,"BEFORE")) D
. . S PXKBEF(PXKSUB,PXKSUBIEN)=$G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKSUBIEN,"BEFORE"))
. . F PXKI=1:1:$L(PXKBEF(PXKSUB,PXKSUBIEN),"^") D
. . . I $P(PXKBEF(PXKSUB,PXKSUBIEN),"^",PXKI)'="" S PXKBV(PXKSUB,PXKSUBIEN,PXKI)=$P(PXKBEF(PXKSUB,PXKSUBIEN),"^",PXKI)
;
I $G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,0,"AFTER"))="@" D
. S PXKAFT(PXKSUB,0)="@"
. S PXKAV(PXKSUB,0)="@"
;
Q
;
CHKAUD ; Check and turn on Auditing
I PXKCAT="IMM" D TURNON^DIAUTL(9000010.11,"*","y")
Q
;
EXIT ;--EXIT
I $D(PXKFVDLM) D MODIFIED^VSIT(PXKVST)
K PXKPXD,TMPPX
K DA,DR,PXKI,PXKJ,PXKLAYGO,PXKDUZ,PXKAFT8,PXKAFTR,VSIT("IEN")
Q
;
EVENT ;--ENTRY POINT TO POST EXECUTE PCE'S EVENT
;Setting the variable PXKNOEVT=1 will stop the event from being
;fired off whenever any data is sent into PCE
;
;PX*1*124 AUTO-POPULATE THE ENCOUNTER SC/EI BASED ON THE ENCOUNTER DX'S
;PX*1.0*164 Relocate the PXCECCLS call
I $D(^TMP("PXKCO",$J)) D
. S PXKVVST=+$O(^TMP("PXKCO",$J,0))
. I $G(PXKVVST),$D(^AUPNVSIT(PXKVVST)) D VST^PXCECCLS(PXKVVST) ;PX*1.0*174
;
I $G(PXKNOEVT) K ^TMP("PXKCO",$J) Q
D EVENT^PXKMASC
Q
;
CQDEL ;Classification question deletion check
I PXKCAT'="VST" Q
S PXJ="" F S PXJ=$O(PXKBV(800,PXJ)) Q:'PXJ I PXKBV(800,PXJ)'="" I '$D(PXKAV(800,PXJ)) S PXKAV(800,PXJ)="@"
K PXJ Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXKMAIN 7800 printed Oct 16, 2024@18:30:03 Page 2
PXKMAIN ;ISL/JVS,PKR,ISA/Zoltan - Main Routine for Data Capture ;03/12/2020
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,59,73,88,69,117,130,124,174,164,210,215,216,211**;Aug 12, 1996;Build 454
+2 ;+This routine is responsible for:
+3 ;+
+4 ;+LOCAL VARIABLE LIST:
+5 ;+ PXFG = Stop flag with duplicate of delete
+6 ;+ PXKAFT = After node
+7 ;+ PXKBEF = Before node
+8 ;+ PXKAV = Pieces from the after node
+9 ;+ PXKBV = Pieces from the before node
+10 ;+ PXKERROR = Set when there is an error
+11 ;+ PXKFGAD = ADD flag
+12 ;+ PXKFGED = EDIT flag
+13 ;+ PXKFGDE = DELETE flag
+14 ;+ PXKSEQ = Sequence number in PXK TMP global
+15 ;+ PXKCAT = Category of entry (CPT,MSR,VST...)
+16 ;+ PXKREF = Root of temp global
+17 ;+ PXKPIEN = IEN of v file or the visit file
+18 ;+ PXKREF = The original reference we are ordering off of
+19 ;+ PXKRT = name of the node in the v file
+20 ;+ PXKRTN = routine name for the file routine
+21 ;+ PXKSOR = the data source for this entry
+22 ;+ PXKSUB = the subscript the data is located on the v file
+23 ;+ PXKVST = the visit IEN
+24 ;+ PXKDUZ = the DUZ of the user
+25 ;+ *PXKHLR* = A variable set by calling routine so that duplicate
+26 ;+ PXKERROR messages aren't produced.
+27 ;
+28 WRITE !,"This is not an entry point"
QUIT
EN1 ;+Main entry point to read ^TMP("PXK", Global
+1 ;+ Partial ^TMP Global Structure when called:
+2 ;+ ^TMP("PXK",$J,"SOR") = Source ien
+3 ;+
+4 ;+ ^TMP("PXK",$J,"VST",1,0,"BEFORE") = the 0-node of the visit file
+5 ;+ ^TMP("PXK",$J,"VST",1,0,"AFTER") = 0-node after changes.
+6 ;+ ^TMP("PXK",$J,"VST",provider counter,"IEN") = ""
+7 ;+
+8 ;+ ^TMP("PXK",$J,"PRV",provider counter,0,"BEFORE") = ""
+9 ;+ ^TMP("PXK",$J,"PRV",provider counter,0,"AFTER") = Provider id^DFN^Visitien^'P' or 'S' for primary/secondary
+10 ;+ ^TMP("PXK",$J,"PRV",provider counter,"IEN") = ""
+11 ;+ ^TMP("PXK",$J,"PRV",provider counter,"BEFORE") = ""
+12 ;+ ^TMP("PXK",$J,"PRV",provider counter,"AFTER") = ^Package ien^Source ien
+13 ;+
+14 NEW LOCK,PXKDUZ,VISITIEN
+15 KILL PXKERROR
+16 IF '$GET(PXKDUZ)
SET PXKDUZ=$SELECT($GET(DUZ):DUZ,1:.5)
+17 DO VST(.VISITIEN,PXKDUZ,.LOCK)
+18 IF LOCK=0
SET PXAERRF=4
QUIT
+19 IF VISITIEN>0
DO UNLOCK^PXLOCK(VISITIEN,PXKDUZ)
+20 QUIT
+21 ;
+22 ;VST ;--Check for visit node and get one created or quit.
VST(VISITIEN,PXKDUZ,LOCK) ;--Check for visit node and get one created or quit.
+1 SET LOCK=0
SET VISITIEN=""
+2 IF '$GET(^TMP("PXK",$JOB,"VST",1,"IEN"))
DO VSIT^PXKVST
+3 IF +$GET(^TMP("PXK",$JOB,"VST",1,"IEN"))=-1
SET PXKERROR("VISIT")="Visit Tracking could not get a visit."
QUIT
+4 IF +$GET(^TMP("PXK",$JOB,"VST",1,"IEN"))=-2
SET PXKERROR("VISIT")="PCE is not activated in Visit Tracking Parameters and thus cannot create visits."
QUIT
+5 IF +$GET(^TMP("PXK",$JOB,"VST",1,"IEN"))<1
SET PXKERROR("VISIT")="Did not get a visit^"_$GET(^TMP("PXK",$JOB,"VST",1,"IEN"))
QUIT
+6 SET VISITIEN=^TMP("PXK",$JOB,"VST",1,"IEN")
+7 SET LOCK=$$LOCK^PXLOCK(VISITIEN,PXKDUZ,2,.PXKERROR)
+8 IF LOCK=0
QUIT
+9 ;
NEW ;--New variables and set main variables
+1 NEW PXKDFN,PXKSOR,PXKVST,PXKSEQ,PXFG,PXKAFT,PXKBEF,PXKAUDIT
+2 NEW PXKCAT,PXKCO,PXKER,PXKFGAD,PXKFGED,PXKFGDE,PXKNOD,PXKPCE
+3 NEW PXKPIEN,PXKREF,PXKRTN,PXKSORR,PXKSUB,PXKVCAT
+4 NEW PXKPTR,PXDFG,PX,PXJJ,PXJJJ,PXKAFT8,PXKAFTR,PXKGN,PXKN,PXKNOW,PXKP
+5 NEW PXKRRT,PXKVRTN,PXKRT,PXKFVDLM,TMPPX
PRVTYPE ;---DO PROVIDER TYPE--PXKMAIN2
+1 DO PRVTYPE^PXKMAIN2
+2 ;
SET ;--SET VARIABLES NECESSARY
+1 ;'DA' should not be defined at this point
+2 ;PX*1.0*117
NEW DA
+3 ;
+4 SET PXFG=0
SET TMPPX="^"
SET PXKLAYGO=""
SET PXDFG=0
SOURCE SET PXKSOR=$GET(^TMP("PXK",$JOB,"SOR"))
Begin DoDot:1
+1 SET PXKCO("SOR")=PXKSOR
+2 IF $DATA(PXKSOR)']""
SET PXKERROR("SOURCE")=""
QUIT
End DoDot:1
if $DATA(PXKERROR("SOURCE"))
QUIT
VISIT SET (PXKVST,VSIT("IEN"))=$GET(^TMP("PXK",$JOB,"VST",1,"IEN"))
ORDER ;--$ORDER Through the ^TMP("PXK", global setting variables
+1 SET PXKREF="^TMP(""PXK"",$J)"
CATEG SET PXKCAT=""
FOR
SET (PXKCAT,PXKVCAT)=$ORDER(@PXKREF@(PXKCAT))
if PXKCAT=""
QUIT
Begin DoDot:1
+1 IF PXKCAT="VST"
SET PXKVCAT="SIT"
+2 SET PXKRTN="PXKF"_PXKCAT
+3 SET X=PXKRTN
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
SEQUE SET PXKSEQ=0
FOR
SET PXKSEQ=$ORDER(@PXKREF@(PXKCAT,PXKSEQ))
KILL PXKAV,PXKBV
SET PXFG=0
if 'PXKSEQ
QUIT
Begin DoDot:2
+1 SET PXKPIEN=$GET(@PXKREF@(PXKCAT,PXKSEQ,"IEN"))
SET (PXKFGAD,PXKFGDE,PXKFGED,PXDFG)=0
SUBSCR SET PXKSUB=""
FOR
SET PXKSUB=$ORDER(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB))
if PXKSUB["IEN"
QUIT
if PXFG=1
QUIT
if PXDFG=1
QUIT
Begin DoDot:3
AFTER SET PXKAFT(PXKSUB)=$GET(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,"AFTER"))
BEFORE SET PXKBEF(PXKSUB)=$GET(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,"BEFORE"))
+1 IF PXKCAT="CPT"
IF PXKSUB=1
DO SUBSCR^PXKMOD
+2 IF PXKCAT="IMM"
IF PXKSUB?1(1"2",1"3",1"11")
DO MULT
+3 DO LOOP^PXKMAIN1
IF PXKSUB=0
DO ERROR^PXKMAIN1
+4 SET PXDFG=0
IF $GET(PXKAV(0,1))["@"!('$DATA(PXKAV(0,1)))
SET PXKAFT(PXKSUB)=""
KILL PXKAV(0)
SET PXDFG=1
End DoDot:3
+5 if PXFG=1
QUIT
+6 IF $DATA(PXKAV)
IF '$DATA(PXKBV)
SET PXKSORR=PXKSOR_"-A "_PXKDUZ
SET PXKFGAD=1
IF PXKCAT["VST"
SET PXKFGAD=0
+7 IF '$DATA(PXKAV)
IF $DATA(PXKBV)
SET PXKFGDE=1
SET PXKFVDLM=""
Begin DoDot:3
+8 SET PXKRT=$PIECE($TEXT(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")"
IF $DATA(@PXKRT)
DO CHKAUD
DO DELETE^PXKMAIN1
DO EN1^PXKMASC
SET PXFG=1
KILL PXKRT
QUIT
End DoDot:3
+9 IF 'PXKFGAD
IF 'PXKFGDE
Begin DoDot:3
+10 IF PXKCAT="VST"
DO CQDEL
+11 DO CLEAN^PXKMAIN1
+12 IF $DATA(PXKAV)
SET PXKSORR=PXKSOR_"-E "_PXKDUZ
SET PXKFGED=1
IF PXKCAT="VST"
IF '$DATA(PXKBV)
IF $DATA(PXKVST)
SET PXKFGED=0
End DoDot:3
+13 IF 'PXKFGAD
IF 'PXKFGDE
IF 'PXKFGED
IF PXKCAT["VST"
DO EN1^PXKMASC
+14 IF PXKFGAD=1
Begin DoDot:3
+15 DO ERROR^PXKMAIN1
+16 IF $DATA(PXKERROR(PXKCAT,PXKSEQ))
SET PXFG=1
+17 if 'PXFG
DO DUP^PXKMAIN1
+18 IF PXFG=1
Begin DoDot:4
+19 if PXKCAT'="CPT"
QUIT
+20 IF $GET(@PXKREF@(PXKCAT,PXKSEQ,"IEN"))]""
DO REMOVE^PXCEVFIL(@PXKREF@(PXKCAT,PXKSEQ,"IEN"))
End DoDot:4
QUIT
+21 ;FILE^PXKMAIN1 MAKES THE ENTRY
+22 if 'PXKPIEN
DO FILE^PXKMAIN1
+23 if '$GET(DA)
SET DA=PXKPIEN
+24 DO AUD2^PXKMAIN1
DO DRDIE^PXKMAIN1
DO EN1^PXKMASC
End DoDot:3
if PXFG
QUIT
+25 IF PXKFGED=1
IF PXKCAT'="VST"
SET PXKRT=$PIECE($TEXT(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")"
if '$DATA(@PXKRT)
QUIT
SET DA=PXKPIEN
DO DUP^PXKMAIN1
if PXFG=1
QUIT
DO AUD12^PXKMAIN1
DO CHKAUD
DO DRDIE^PXKMAIN1
DO EN1^PXKMASC
+26 IF PXKFGED=1
IF PXKCAT="VST"
SET PXKRT=$PIECE($TEXT(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")"
if '$DATA(@PXKRT)
QUIT
SET DA=PXKPIEN
DO DUP^PXKMAIN1
if PXFG=1
QUIT
DO DRDIE^PXKMAIN1
DO EN1^PXKMASC
+27 DO SPEC2^PXKMAIN2
+28 DO EN^PXKMCODE
+29 KILL PXKAFT,PXKBEF
End DoDot:2
End DoDot:1
+30 IF $DATA(^TMP("PXKSAVE",$JOB))
DO RECALL^PXKMAIN2
+31 DO EXIT
+32 QUIT
+33 ;
MULT ; Add multiples to PXKAFT, PXKBEF, PXKAV, PXKBV arrays
+1 ;
+2 NEW PXKSUBIEN,PXKI
+3 ;
+4 SET PXKSUBIEN=0
+5 FOR
SET PXKSUBIEN=$ORDER(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKSUBIEN))
if 'PXKSUBIEN
QUIT
Begin DoDot:1
+6 ;
+7 IF $DATA(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKSUBIEN,"AFTER"))
Begin DoDot:2
+8 SET PXKAFT(PXKSUB,PXKSUBIEN)=$GET(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKSUBIEN,"AFTER"))
+9 FOR PXKI=1:1:$LENGTH(PXKAFT(PXKSUB,PXKSUBIEN),"^")
Begin DoDot:3
+10 IF $PIECE(PXKAFT(PXKSUB,PXKSUBIEN),"^",PXKI)'=""
SET PXKAV(PXKSUB,PXKSUBIEN,PXKI)=$PIECE(PXKAFT(PXKSUB,PXKSUBIEN),"^",PXKI)
End DoDot:3
End DoDot:2
+11 ;
+12 IF $DATA(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKSUBIEN,"BEFORE"))
Begin DoDot:2
+13 SET PXKBEF(PXKSUB,PXKSUBIEN)=$GET(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,PXKSUBIEN,"BEFORE"))
+14 FOR PXKI=1:1:$LENGTH(PXKBEF(PXKSUB,PXKSUBIEN),"^")
Begin DoDot:3
+15 IF $PIECE(PXKBEF(PXKSUB,PXKSUBIEN),"^",PXKI)'=""
SET PXKBV(PXKSUB,PXKSUBIEN,PXKI)=$PIECE(PXKBEF(PXKSUB,PXKSUBIEN),"^",PXKI)
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;
+17 IF $GET(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,0,"AFTER"))="@"
Begin DoDot:1
+18 SET PXKAFT(PXKSUB,0)="@"
+19 SET PXKAV(PXKSUB,0)="@"
End DoDot:1
+20 ;
+21 QUIT
+22 ;
CHKAUD ; Check and turn on Auditing
+1 IF PXKCAT="IMM"
DO TURNON^DIAUTL(9000010.11,"*","y")
+2 QUIT
+3 ;
EXIT ;--EXIT
+1 IF $DATA(PXKFVDLM)
DO MODIFIED^VSIT(PXKVST)
+2 KILL PXKPXD,TMPPX
+3 KILL DA,DR,PXKI,PXKJ,PXKLAYGO,PXKDUZ,PXKAFT8,PXKAFTR,VSIT("IEN")
+4 QUIT
+5 ;
EVENT ;--ENTRY POINT TO POST EXECUTE PCE'S EVENT
+1 ;Setting the variable PXKNOEVT=1 will stop the event from being
+2 ;fired off whenever any data is sent into PCE
+3 ;
+4 ;PX*1*124 AUTO-POPULATE THE ENCOUNTER SC/EI BASED ON THE ENCOUNTER DX'S
+5 ;PX*1.0*164 Relocate the PXCECCLS call
+6 IF $DATA(^TMP("PXKCO",$JOB))
Begin DoDot:1
+7 SET PXKVVST=+$ORDER(^TMP("PXKCO",$JOB,0))
+8 ;PX*1.0*174
IF $GET(PXKVVST)
IF $DATA(^AUPNVSIT(PXKVVST))
DO VST^PXCECCLS(PXKVVST)
End DoDot:1
+9 ;
+10 IF $GET(PXKNOEVT)
KILL ^TMP("PXKCO",$JOB)
QUIT
+11 DO EVENT^PXKMASC
+12 QUIT
+13 ;
CQDEL ;Classification question deletion check
+1 IF PXKCAT'="VST"
QUIT
+2 SET PXJ=""
FOR
SET PXJ=$ORDER(PXKBV(800,PXJ))
if 'PXJ
QUIT
IF PXKBV(800,PXJ)'=""
IF '$DATA(PXKAV(800,PXJ))
SET PXKAV(800,PXJ)="@"
+3 KILL PXJ
QUIT
+4 ;
