PXKMASC ;ISL/JVS - Build and Pass to auto-check-out ;03/12/2020
;;1.0;PCE PATIENT CARE ENCOUNTER;**22,41,73,164,210,211**;Aug 12, 1996;Build 454
; Builds and passes data to MAS for Auto-checkout
;Variable List
;
EN1 ;Build the Temp global for MAS AND THE WORLD.
;S PXKGN=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_","
;^TMP("PXKCO",$J,<VISIT IEN>,"PRV",<PROVIDER IEN>,0,"AFTER")=DATA
; "" "" "" ,"BEFORE")=DATA
N PXKGG,PXKSUB,PXKMOD,PXKSEQ,PXKOE,PXKVAL
Q:PXKSOR=$O(^PX(839.7,"B","PIMS CHECK-OUT",0))
S PXKGG=0
S PXKSUB=""
F S PXKSUB=$O(PXKAFT(PXKSUB)) Q:PXKSUB="" D
. I PXKSUB'=1!(PXKCAT="IMM") D PXGO Q
. S PXKSEQ=""
. F S PXKSEQ=$O(PXKAFT(PXKSUB,PXKSEQ)) Q:PXKSEQ="" D
.. S PXKMOD=PXKAFT(PXKSUB,PXKSEQ)
.. D PXGO
Q
PXGO ;
S PXKGG=0
S PXKGN=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_","
I PXKSUB'=1!(PXKCAT="IMM") D
. I $D(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE")) S PXKGG=1
. S PXKGN=PXKGN_PXKSUB_")"
I PXKSUB=1 D
. I PXKMOD]"",$D(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE",PXKMOD)) S PXKGG=1
. S PXKGN=PXKGN_PXKSUB_","_PXKSEQ_","_0_")"
D @$S(PXKGG=1:"DUP",1:"ORG")
D DEL
D PTR
Q
;
DUP ;Overwrite if a duplicate just the After Node
I PXKCAT="IMM",PXKSUB?1(1"2",1"3",1"11") D Q
. N PXKMIEN
. S PXKMIEN=0
. F S PXKMIEN=$O(@PXKGN@(PXKMIEN)) Q:'PXKMIEN D
.. S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER",PXKMIEN)=$G(@PXKGN@(PXKMIEN,0))
I PXKSUB'=1 D Q
. S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER")=$G(@PXKGN)
I $G(@PXKGN)]"" D
. S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER",$G(@PXKGN))=""
Q
;
ORG ;If original copy both
;
I PXKCAT="IMM",PXKSUB?1(1"2",1"3",1"11") D Q
. N PXKMIEN
. ;
. ; Set BEFORE Immunization Multiples
. S PXKMIEN=0
. F S PXKMIEN=$O(PXKBEF(PXKSUB,PXKMIEN)) Q:'PXKMIEN D
. . S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE",PXKMIEN)=PXKBEF(PXKSUB,PXKMIEN)
. ; Set AFTER Immunization Multiples
. S PXKMIEN=0
. F S PXKMIEN=$O(@PXKGN@(PXKMIEN)) Q:'PXKMIEN D
.. S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER",PXKMIEN)=$G(@PXKGN@(PXKMIEN,0))
;
I PXKSUB'=1 D Q
. S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER")=$G(@PXKGN)
. S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE")=$G(PXKBEF(PXKSUB))
I $G(@PXKGN)]"" D
. S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER",$G(@PXKGN))=""
I $G(PXKBEF(PXKSUB,PXKSEQ))]"" D
. S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE",PXKBEF(PXKSUB,PXKSEQ))=""
Q
;
DEL ;DELETE IF BOTH ARE NULL
I '$D(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,0)) D
.K ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN)
I $G(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,0,"AFTER"))']"" D
.I $G(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,0,"BEFORE"))']"" D
..K ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN)
I $P($G(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,0,"AFTER")),"^",1)="@" D
.K ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN)
Q
;
PTR ; Set the Provider Narrative equal to the pointer in the files etc.
N PXJ,PXJJ,PXJJJ,PXKR
I $D(PXKPTR) S PXJ="" F S PXJ=$O(PXKPTR(PXJ)) Q:PXJ="" D
.S PXJJ="" F S PXJJ=$O(PXKPTR(PXJ,PXJJ)) Q:PXJJ="" D
..S PXJJJ="" F S PXJJJ=$O(PXKPTR(PXJ,PXJJ,PXJJJ)) Q:PXJJJ="" D
...S PXKR=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXJ_","_PXJJ_")"
...I $D(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXJ,PXJJ,"AFTER")) D
....S $P(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXJ,PXJJ,"AFTER"),"^",PXJJJ)=$P($G(@PXKR),"^",PXJJJ)
Q
;
EVENT ; EVENT TO PRESENT THE DATA TO OTHER USERS
I '$D(^TMP("PXKCO",$J)) Q
N SOR,SOURCE
S SOR=$G(PXKCO("SOR"))
I SOR="" S SOR=+$P($G(^AUPNVSIT(PXKVVST,812)),U,2)
S SOURCE=$S(SOR>0:$G(^PX(839.7,SOR,0)),1:"")
S PXKVVST=+$O(^TMP("PXKCO",$J,0))
S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,0,"AFTER")=$G(^AUPNVSIT(PXKVVST,0))
S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,21,"AFTER")=$G(^AUPNVSIT(PXKVVST,21))
S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,800,"AFTER")=$G(^AUPNVSIT(PXKVVST,800))
S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,811,"AFTER")=$G(^AUPNVSIT(PXKVVST,811))
S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,150,"AFTER")=$G(^AUPNVSIT(PXKVVST,150))
S ^TMP("PXKCO",$J,PXKVVST,"SOR",SOR,0,"AFTER")=SOURCE
S ^TMP("PXKCO",$J,PXKVVST,"SOR",SOR,0,"BEFORE")=SOURCE
S PXKOE=$O(^SCE("AVSIT",PXKVVST,"")) I PXKOE]"" S ^TMP("PXKCO",$J,PXKVVST,"OE",PXKOE,0,"BEFORE")=$G(^SCE(PXKOE,0))
D COEVENT^PXKENC(PXKVVST) ;finishes the ^TMP("PXKCO",$J array
;Make the call to Scheduling before the protocol event is tasked.
;ICR #2026
D EN^SDPCE
;Task the PXK VISIT DATA EVENT protocol event.
D PXKVDETASK
D FINAL^SCDXHLDR(PXKVVST,$G(PXKVST))
UPD ;UP DATE VISIT FILE
;--REMOVE CHECK OUT DATE TIME
N PXSWINFO S PXSWINFO=$$SWSTAT^IBBAPI()
N VSIT
I $D(PXKVVST),$D(^AUPNVSIT(PXKVVST)) S VSIT("IEN")=PXKVVST,VSIT("COD")="@" D CHKACCT D UPD^VSIT ;PX*1.0*164
I +PXSWINFO D
.I $P($G(^AUPNVSIT(PXKVVST,0)),"^",1)<$P(PXSWINFO,"^",2),$P($G(^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,0,"BEFORE")),"^",1)<$P(PXSWINFO,"^",2) Q ;Check visit for PFSS Activation date
.S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,0,"AFTER")=$G(^AUPNVSIT(PXKVVST,0))
.S X=+$O(^ORD(101,"B","PX IBB CACHE FILING EVENT",0))_";ORD(101,"
.D EN^XQOR
K ^TMP("PXKCO",$J),PXKVVST,PXKCO,VSIT
K ^TMP("PXKENC",$J)
Q
CHKACCT ;
N PXSWINFO S PXSWINFO=$$SWSTAT^IBBAPI()
N OUTENC,PXPV1,PXPV2,SEQ,PXCPT0,PXPRV0,PXOERR,PXCPT,PXORREF,PXPROS
Q:'+PXSWINFO
Q:$P($G(^AUPNVSIT(PXKVVST,0)),"^",1)<$P(PXSWINFO,"^",2) ;Check visit for PFSS Activation date
Q:$P($G(^AUPNVSIT(PXKVVST,0)),"^",7)="E" ;NO ACCOUNT # FOR HISTORIC ENCOUNTERS
Q:$P($G(^AUPNVSIT(PXKVVST,0)),"^",7)="H" ;NO ACCOUNT # FOR HOSPTIALIZATION ENCOUNTERS
Q:$P($G(^AUPNVSIT(PXKVVST,812)),"^",2)=$$PKG2IEN^VSIT("RMPR") ;NO ACCOUNT # FOR PROSTHETICS
;Check for existing ACT
S VSIT("ACT")=$P($G(^AUPNVSIT(PXKVVST,0)),"^",26) Q:VSIT("ACT")
;Check Scheduling
I $T(GETARN^SDPFSS2)'="" S VSIT("ACT")=$$GETARN^SDPFSS2($P(^AUPNVSIT(PXKVVST,0),"^",1),$P(^AUPNVSIT(PXKVVST,0),"^",5),$P(^AUPNVSIT(PXKVVST,0),"^",22)) Q:VSIT("ACT")]0 S VSIT("ACT")=""
;Check CPT codes for Lab 108, call ORWPFSS,
I $E($T(ORACTREF^ORWPFSS),9)="(" S PXOERR=1 D Q:PXOERR
.I '$D(^TMP("PXKCO",$J,PXKVVST,"CPT")) S PXOERR=0 Q ;No CPT codes, so Get Acct Ref
.S SEQ="" F S SEQ=$O(^TMP("PXKCO",$J,PXKVVST,"CPT",SEQ)) Q:SEQ="" D Q:'PXOERR
..S PXCPT0=$G(^TMP("PXKCO",$J,PXKVVST,"CPT",SEQ,0,"AFTER"))
..I $P(PXCPT0,"^",19)'=108 S PXOERR=0 Q ;Not Lab, so Get Acct Ref
..I $P(PXCPT0,"^",17)="" S PXOERR=0 Q ;Lab and no Order Reference, so Get Acct Ref
..I $P(PXCPT0,"^",17)'="" S PXCPT=$P(PXCPT0,"^",17) D ORACTREF^ORWPFSS(.PXORREF,.PXCPT) I PXORREF'>0 S PXOERR=0 ;Lab and no Acct Ref, so Get Acct Ref
;Call Get IBBACCT
S PXPV1(2)=$P(^AUPNVSIT(PXKVVST,150),"^",2) S PXPV1(2)=$S(PXPV1(2)=1:"I",PXPV1(2)=0:"O",1:"") ;Inpatient, Outpatient
S PXPV1(3)=$P(^AUPNVSIT(PXKVVST,0),"^",22) Q:PXPV1(3)="" ;Hospital Location, Quit for Outside Locations
S OUTENC=$O(^SCE("AVSIT",PXKVVST,0)) I OUTENC]"" S PXPV1(4)=$P(^SCE(OUTENC,0),"^",10) ;Appointment type
;Attending search
S PXPV1(7)=""
S SEQ="" F S SEQ=$O(^TMP("PXKCO",$J,PXKVVST,"PRV",SEQ)) Q:SEQ="" D Q:PXPV1(7)]""
.S PXPRV0=$G(^TMP("PXKCO",$J,PXKVVST,"PRV",SEQ,0,"AFTER"))
.I $P(PXPRV0,"^",5)="A" S PXPV1(7)=$P(PXPRV0,"^",1)
S PXPV1(18)=$P(^AUPNVSIT(PXKVVST,0),"^",8) ;DSS ID
S PXPV1(44)=$P(^AUPNVSIT(PXKVVST,0),"^",1) ;Visit D/T
S PXPV2(7)="" S:$P(^AUPNVSIT(PXKVVST,0),"^",21) PXPV2(7)=$P(^DIC(8,$P(^AUPNVSIT(PXKVVST,0),"^",21),0),"^",9) ;Eligibility
S VSIT("PAT")=$P(^AUPNVSIT(PXKVVST,0),"^",5)
S VSIT("ACT")=$$GETACCT^IBBAPI(VSIT("PAT"),"","A04","PXKMASC",.PXPV1,.PXPV2,,,,"","")
K VSIT("PAT")
Q
;
PXKVDERTN ;Execute the PXK VISIT DATA EVENT protocol.
N X
S X=+$O(^ORD(101,"B","PXK VISIT DATA EVENT",0))_";ORD(101,"
D EN^XQOR
K ^TMP("PXKCO",$J)
Q
;
PXKVDETASK ;Task the PXK VISTA DATA EVENT protocol event.
N ZTREQ,ZTSAVE,ZTSK,ZTIO,ZTDTH,ZTRTN
S ZTREQ="@"
S ZTSAVE("^TMP(""PXKCO"",$J,")=""
S ZTRTN="PXKVDERTN^PXKMASC"
S ZTDESC="PXK VISIT DATA EVENT"
S ZTDTH=$$NOW^XLFDT
S ZTIO=""
D ^%ZTLOAD
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXKMASC 8165 printed Dec 13, 2024@02:29:29 Page 2
PXKMASC ;ISL/JVS - Build and Pass to auto-check-out ;03/12/2020
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,41,73,164,210,211**;Aug 12, 1996;Build 454
+2 ; Builds and passes data to MAS for Auto-checkout
+3 ;Variable List
+4 ;
EN1 ;Build the Temp global for MAS AND THE WORLD.
+1 ;S PXKGN=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_","
+2 ;^TMP("PXKCO",$J,<VISIT IEN>,"PRV",<PROVIDER IEN>,0,"AFTER")=DATA
+3 ; "" "" "" ,"BEFORE")=DATA
+4 NEW PXKGG,PXKSUB,PXKMOD,PXKSEQ,PXKOE,PXKVAL
+5 if PXKSOR=$ORDER(^PX(839.7,"B","PIMS CHECK-OUT",0))
QUIT
+6 SET PXKGG=0
+7 SET PXKSUB=""
+8 FOR
SET PXKSUB=$ORDER(PXKAFT(PXKSUB))
if PXKSUB=""
QUIT
Begin DoDot:1
+9 IF PXKSUB'=1!(PXKCAT="IMM")
DO PXGO
QUIT
+10 SET PXKSEQ=""
+11 FOR
SET PXKSEQ=$ORDER(PXKAFT(PXKSUB,PXKSEQ))
if PXKSEQ=""
QUIT
Begin DoDot:2
+12 SET PXKMOD=PXKAFT(PXKSUB,PXKSEQ)
+13 DO PXGO
End DoDot:2
End DoDot:1
+14 QUIT
PXGO ;
+1 SET PXKGG=0
+2 SET PXKGN=$PIECE($TEXT(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_","
+3 IF PXKSUB'=1!(PXKCAT="IMM")
Begin DoDot:1
+4 IF $DATA(^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE"))
SET PXKGG=1
+5 SET PXKGN=PXKGN_PXKSUB_")"
End DoDot:1
+6 IF PXKSUB=1
Begin DoDot:1
+7 IF PXKMOD]""
IF $DATA(^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE",PXKMOD))
SET PXKGG=1
+8 SET PXKGN=PXKGN_PXKSUB_","_PXKSEQ_","_0_")"
End DoDot:1
+9 DO @$SELECT(PXKGG=1:"DUP",1:"ORG")
+10 DO DEL
+11 DO PTR
+12 QUIT
+13 ;
DUP ;Overwrite if a duplicate just the After Node
+1 IF PXKCAT="IMM"
IF PXKSUB?1(1"2",1"3",1"11")
Begin DoDot:1
+2 NEW PXKMIEN
+3 SET PXKMIEN=0
+4 FOR
SET PXKMIEN=$ORDER(@PXKGN@(PXKMIEN))
if 'PXKMIEN
QUIT
Begin DoDot:2
+5 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER",PXKMIEN)=$GET(@PXKGN@(PXKMIEN,0))
End DoDot:2
End DoDot:1
QUIT
+6 IF PXKSUB'=1
Begin DoDot:1
+7 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER")=$GET(@PXKGN)
End DoDot:1
QUIT
+8 IF $GET(@PXKGN)]""
Begin DoDot:1
+9 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER",$GET(@PXKGN))=""
End DoDot:1
+10 QUIT
+11 ;
ORG ;If original copy both
+1 ;
+2 IF PXKCAT="IMM"
IF PXKSUB?1(1"2",1"3",1"11")
Begin DoDot:1
+3 NEW PXKMIEN
+4 ;
+5 ; Set BEFORE Immunization Multiples
+6 SET PXKMIEN=0
+7 FOR
SET PXKMIEN=$ORDER(PXKBEF(PXKSUB,PXKMIEN))
if 'PXKMIEN
QUIT
Begin DoDot:2
+8 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE",PXKMIEN)=PXKBEF(PXKSUB,PXKMIEN)
End DoDot:2
+9 ; Set AFTER Immunization Multiples
+10 SET PXKMIEN=0
+11 FOR
SET PXKMIEN=$ORDER(@PXKGN@(PXKMIEN))
if 'PXKMIEN
QUIT
Begin DoDot:2
+12 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER",PXKMIEN)=$GET(@PXKGN@(PXKMIEN,0))
End DoDot:2
End DoDot:1
QUIT
+13 ;
+14 IF PXKSUB'=1
Begin DoDot:1
+15 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER")=$GET(@PXKGN)
+16 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE")=$GET(PXKBEF(PXKSUB))
End DoDot:1
QUIT
+17 IF $GET(@PXKGN)]""
Begin DoDot:1
+18 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER",$GET(@PXKGN))=""
End DoDot:1
+19 IF $GET(PXKBEF(PXKSUB,PXKSEQ))]""
Begin DoDot:1
+20 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE",PXKBEF(PXKSUB,PXKSEQ))=""
End DoDot:1
+21 QUIT
+22 ;
DEL ;DELETE IF BOTH ARE NULL
+1 IF '$DATA(^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,0))
Begin DoDot:1
+2 KILL ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN)
End DoDot:1
+3 IF $GET(^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,0,"AFTER"))']""
Begin DoDot:1
+4 IF $GET(^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,0,"BEFORE"))']""
Begin DoDot:2
+5 KILL ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN)
End DoDot:2
End DoDot:1
+6 IF $PIECE($GET(^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,0,"AFTER")),"^",1)="@"
Begin DoDot:1
+7 KILL ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN)
End DoDot:1
+8 QUIT
+9 ;
PTR ; Set the Provider Narrative equal to the pointer in the files etc.
+1 NEW PXJ,PXJJ,PXJJJ,PXKR
+2 IF $DATA(PXKPTR)
SET PXJ=""
FOR
SET PXJ=$ORDER(PXKPTR(PXJ))
if PXJ=""
QUIT
Begin DoDot:1
+3 SET PXJJ=""
FOR
SET PXJJ=$ORDER(PXKPTR(PXJ,PXJJ))
if PXJJ=""
QUIT
Begin DoDot:2
+4 SET PXJJJ=""
FOR
SET PXJJJ=$ORDER(PXKPTR(PXJ,PXJJ,PXJJJ))
if PXJJJ=""
QUIT
Begin DoDot:3
+5 SET PXKR=$PIECE($TEXT(GLOBAL^@PXKRTN),";;",2)_"("_PXJ_","_PXJJ_")"
+6 IF $DATA(^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXJ,PXJJ,"AFTER"))
Begin DoDot:4
+7 SET $PIECE(^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXJ,PXJJ,"AFTER"),"^",PXJJJ)=$PIECE($GET(@PXKR),"^",PXJJJ)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
EVENT ; EVENT TO PRESENT THE DATA TO OTHER USERS
+1 IF '$DATA(^TMP("PXKCO",$JOB))
QUIT
+2 NEW SOR,SOURCE
+3 SET SOR=$GET(PXKCO("SOR"))
+4 IF SOR=""
SET SOR=+$PIECE($GET(^AUPNVSIT(PXKVVST,812)),U,2)
+5 SET SOURCE=$SELECT(SOR>0:$GET(^PX(839.7,SOR,0)),1:"")
+6 SET PXKVVST=+$ORDER(^TMP("PXKCO",$JOB,0))
+7 SET ^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,0,"AFTER")=$GET(^AUPNVSIT(PXKVVST,0))
+8 SET ^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,21,"AFTER")=$GET(^AUPNVSIT(PXKVVST,21))
+9 SET ^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,800,"AFTER")=$GET(^AUPNVSIT(PXKVVST,800))
+10 SET ^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,811,"AFTER")=$GET(^AUPNVSIT(PXKVVST,811))
+11 SET ^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,150,"AFTER")=$GET(^AUPNVSIT(PXKVVST,150))
+12 SET ^TMP("PXKCO",$JOB,PXKVVST,"SOR",SOR,0,"AFTER")=SOURCE
+13 SET ^TMP("PXKCO",$JOB,PXKVVST,"SOR",SOR,0,"BEFORE")=SOURCE
+14 SET PXKOE=$ORDER(^SCE("AVSIT",PXKVVST,""))
IF PXKOE]""
SET ^TMP("PXKCO",$JOB,PXKVVST,"OE",PXKOE,0,"BEFORE")=$GET(^SCE(PXKOE,0))
+15 ;finishes the ^TMP("PXKCO",$J array
DO COEVENT^PXKENC(PXKVVST)
+16 ;Make the call to Scheduling before the protocol event is tasked.
+17 ;ICR #2026
+18 DO EN^SDPCE
+19 ;Task the PXK VISIT DATA EVENT protocol event.
+20 DO PXKVDETASK
+21 DO FINAL^SCDXHLDR(PXKVVST,$GET(PXKVST))
UPD ;UP DATE VISIT FILE
+1 ;--REMOVE CHECK OUT DATE TIME
+2 NEW PXSWINFO
SET PXSWINFO=$$SWSTAT^IBBAPI()
+3 NEW VSIT
+4 ;PX*1.0*164
IF $DATA(PXKVVST)
IF $DATA(^AUPNVSIT(PXKVVST))
SET VSIT("IEN")=PXKVVST
SET VSIT("COD")="@"
DO CHKACCT
DO UPD^VSIT
+5 IF +PXSWINFO
Begin DoDot:1
+6 ;Check visit for PFSS Activation date
IF $PIECE($GET(^AUPNVSIT(PXKVVST,0)),"^",1)<$PIECE(PXSWINFO,"^",2)
IF $PIECE($GET(^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,0,"BEFORE")),"^",1)<$PIECE(PXSWINFO,"^",2)
QUIT
+7 SET ^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,0,"AFTER")=$GET(^AUPNVSIT(PXKVVST,0))
+8 SET X=+$ORDER(^ORD(101,"B","PX IBB CACHE FILING EVENT",0))_";ORD(101,"
+9 DO EN^XQOR
End DoDot:1
+10 KILL ^TMP("PXKCO",$JOB),PXKVVST,PXKCO,VSIT
+11 KILL ^TMP("PXKENC",$JOB)
+12 QUIT
CHKACCT ;
+1 NEW PXSWINFO
SET PXSWINFO=$$SWSTAT^IBBAPI()
+2 NEW OUTENC,PXPV1,PXPV2,SEQ,PXCPT0,PXPRV0,PXOERR,PXCPT,PXORREF,PXPROS
+3 if '+PXSWINFO
QUIT
+4 ;Check visit for PFSS Activation date
if $PIECE($GET(^AUPNVSIT(PXKVVST,0)),"^",1)<$PIECE(PXSWINFO,"^",2)
QUIT
+5 ;NO ACCOUNT # FOR HISTORIC ENCOUNTERS
if $PIECE($GET(^AUPNVSIT(PXKVVST,0)),"^",7)="E"
QUIT
+6 ;NO ACCOUNT # FOR HOSPTIALIZATION ENCOUNTERS
if $PIECE($GET(^AUPNVSIT(PXKVVST,0)),"^",7)="H"
QUIT
+7 ;NO ACCOUNT # FOR PROSTHETICS
if $PIECE($GET(^AUPNVSIT(PXKVVST,812)),"^",2)=$$PKG2IEN^VSIT("RMPR")
QUIT
+8 ;Check for existing ACT
+9 SET VSIT("ACT")=$PIECE($GET(^AUPNVSIT(PXKVVST,0)),"^",26)
if VSIT("ACT")
QUIT
+10 ;Check Scheduling
+11 IF $TEXT(GETARN^SDPFSS2)'=""
SET VSIT("ACT")=$$GETARN^SDPFSS2($PIECE(^AUPNVSIT(PXKVVST,0),"^",1),$PIECE(^AUPNVSIT(PXKVVST,0),"^",5),$PIECE(^AUPNVSIT(PXKVVST,0),"^",22))
if VSIT("ACT")]0
QUIT
SET VSIT("ACT")=""
+12 ;Check CPT codes for Lab 108, call ORWPFSS,
+13 IF $EXTRACT($TEXT(ORACTREF^ORWPFSS),9)="("
SET PXOERR=1
Begin DoDot:1
+14 ;No CPT codes, so Get Acct Ref
IF '$DATA(^TMP("PXKCO",$JOB,PXKVVST,"CPT"))
SET PXOERR=0
QUIT
+15 SET SEQ=""
FOR
SET SEQ=$ORDER(^TMP("PXKCO",$JOB,PXKVVST,"CPT",SEQ))
if SEQ=""
QUIT
Begin DoDot:2
+16 SET PXCPT0=$GET(^TMP("PXKCO",$JOB,PXKVVST,"CPT",SEQ,0,"AFTER"))
+17 ;Not Lab, so Get Acct Ref
IF $PIECE(PXCPT0,"^",19)'=108
SET PXOERR=0
QUIT
+18 ;Lab and no Order Reference, so Get Acct Ref
IF $PIECE(PXCPT0,"^",17)=""
SET PXOERR=0
QUIT
+19 ;Lab and no Acct Ref, so Get Acct Ref
IF $PIECE(PXCPT0,"^",17)'=""
SET PXCPT=$PIECE(PXCPT0,"^",17)
DO ORACTREF^ORWPFSS(.PXORREF,.PXCPT)
IF PXORREF'>0
SET PXOERR=0
End DoDot:2
if 'PXOERR
QUIT
End DoDot:1
if PXOERR
QUIT
+20 ;Call Get IBBACCT
+21 ;Inpatient, Outpatient
SET PXPV1(2)=$PIECE(^AUPNVSIT(PXKVVST,150),"^",2)
SET PXPV1(2)=$SELECT(PXPV1(2)=1:"I",PXPV1(2)=0:"O",1:"")
+22 ;Hospital Location, Quit for Outside Locations
SET PXPV1(3)=$PIECE(^AUPNVSIT(PXKVVST,0),"^",22)
if PXPV1(3)=""
QUIT
+23 ;Appointment type
SET OUTENC=$ORDER(^SCE("AVSIT",PXKVVST,0))
IF OUTENC]""
SET PXPV1(4)=$PIECE(^SCE(OUTENC,0),"^",10)
+24 ;Attending search
+25 SET PXPV1(7)=""
+26 SET SEQ=""
FOR
SET SEQ=$ORDER(^TMP("PXKCO",$JOB,PXKVVST,"PRV",SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+27 SET PXPRV0=$GET(^TMP("PXKCO",$JOB,PXKVVST,"PRV",SEQ,0,"AFTER"))
+28 IF $PIECE(PXPRV0,"^",5)="A"
SET PXPV1(7)=$PIECE(PXPRV0,"^",1)
End DoDot:1
if PXPV1(7)]""
QUIT
+29 ;DSS ID
SET PXPV1(18)=$PIECE(^AUPNVSIT(PXKVVST,0),"^",8)
+30 ;Visit D/T
SET PXPV1(44)=$PIECE(^AUPNVSIT(PXKVVST,0),"^",1)
+31 ;Eligibility
SET PXPV2(7)=""
if $PIECE(^AUPNVSIT(PXKVVST,0),"^",21)
SET PXPV2(7)=$PIECE(^DIC(8,$PIECE(^AUPNVSIT(PXKVVST,0),"^",21),0),"^",9)
+32 SET VSIT("PAT")=$PIECE(^AUPNVSIT(PXKVVST,0),"^",5)
+33 SET VSIT("ACT")=$$GETACCT^IBBAPI(VSIT("PAT"),"","A04","PXKMASC",.PXPV1,.PXPV2,,,,"","")
+34 KILL VSIT("PAT")
+35 QUIT
+36 ;
PXKVDERTN ;Execute the PXK VISIT DATA EVENT protocol.
+1 NEW X
+2 SET X=+$ORDER(^ORD(101,"B","PXK VISIT DATA EVENT",0))_";ORD(101,"
+3 DO EN^XQOR
+4 KILL ^TMP("PXKCO",$JOB)
+5 QUIT
+6 ;
PXKVDETASK ;Task the PXK VISTA DATA EVENT protocol event.
+1 NEW ZTREQ,ZTSAVE,ZTSK,ZTIO,ZTDTH,ZTRTN
+2 SET ZTREQ="@"
+3 SET ZTSAVE("^TMP(""PXKCO"",$J,")=""
+4 SET ZTRTN="PXKVDERTN^PXKMASC"
+5 SET ZTDESC="PXK VISIT DATA EVENT"
+6 SET ZTDTH=$$NOW^XLFDT
+7 SET ZTIO=""
+8 DO ^%ZTLOAD
+9 QUIT
+10 ;
