PXKMASC ;ISL/JVS - Build and Pass to auto-check-out ;7/25/96 08:53
;;1.0;PCE PATIENT CARE ENCOUNTER;**22,41,73**;Aug 12, 1996
; 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
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 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 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 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 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 Narriative 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
Q:'$D(PXKCO("SOR"))
I '$D(^TMP("PXKCO",$J)) Q
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",PXKCO("SOR"),0,"AFTER")=$G(^PX(839.7,PXKCO("SOR"),0))
S ^TMP("PXKCO",$J,PXKVVST,"SOR",PXKCO("SOR"),0,"BEFORE")=$G(^PX(839.7,PXKCO("SOR"),0))
S X=+$O(^ORD(101,"B","PXK VISIT DATA EVENT",0))_";ORD(101,"
;D ENCEVENT^PXKENC(PXKVVST) ;makes the ^TMP("PXKENC",$J, array
D COEVENT^PXKENC(PXKVVST) ;finishes the ^TMP("PXKCO",$J array
D EN^XQOR
D FINAL^SCDXHLDR(PXKVVST,$G(PXKVST))
UPD ;UP DATE VISIT FILE
;--REMOVE CHECK OUT DATE TIME
N VSIT
I $D(PXKVVST),$D(^AUPNVSIT(PXKVVST)) S VSIT("IEN")=PXKVVST,VSIT("COD")="@" D UPD^VSIT
K ^TMP("PXKCO",$J),PXKVVST,PXKCO,VSIT
K ^TMP("PXKENC",$J)
Q
PXKMASC ;ISL/JVS - Build and Pass to auto-check-out ;7/25/96 08:53
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,41,73**;Aug 12, 1996
+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
+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
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
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 PXKSUB'=1
Begin DoDot:1
+2 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER")=$GET(@PXKGN)
End DoDot:1
QUIT
+3 IF $GET(@PXKGN)]""
Begin DoDot:1
+4 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER",$GET(@PXKGN))=""
End DoDot:1
+5 QUIT
+6 ;
ORG ;If original copy both
+1 IF PXKSUB'=1
Begin DoDot:1
+2 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER")=$GET(@PXKGN)
+3 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE")=$GET(PXKBEF(PXKSUB))
End DoDot:1
QUIT
+4 IF $GET(@PXKGN)]""
Begin DoDot:1
+5 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER",$GET(@PXKGN))=""
End DoDot:1
+6 IF $GET(PXKBEF(PXKSUB,PXKSEQ))]""
Begin DoDot:1
+7 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE",PXKBEF(PXKSUB,PXKSEQ))=""
End DoDot:1
+8 QUIT
+9 ;
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 Narriative 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(PXKCO("SOR"))
QUIT
+2 IF '$DATA(^TMP("PXKCO",$JOB))
QUIT
+3 SET PXKVVST=+$ORDER(^TMP("PXKCO",$JOB,0))
+4 SET ^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,0,"AFTER")=$GET(^AUPNVSIT(PXKVVST,0))
+5 SET ^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,21,"AFTER")=$GET(^AUPNVSIT(PXKVVST,21))
+6 SET ^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,800,"AFTER")=$GET(^AUPNVSIT(PXKVVST,800))
+7 SET ^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,811,"AFTER")=$GET(^AUPNVSIT(PXKVVST,811))
+8 SET ^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,150,"AFTER")=$GET(^AUPNVSIT(PXKVVST,150))
+9 SET ^TMP("PXKCO",$JOB,PXKVVST,"SOR",PXKCO("SOR"),0,"AFTER")=$GET(^PX(839.7,PXKCO("SOR"),0))
+10 SET ^TMP("PXKCO",$JOB,PXKVVST,"SOR",PXKCO("SOR"),0,"BEFORE")=$GET(^PX(839.7,PXKCO("SOR"),0))
+11 SET X=+$ORDER(^ORD(101,"B","PXK VISIT DATA EVENT",0))_";ORD(101,"
+12 ;D ENCEVENT^PXKENC(PXKVVST) ;makes the ^TMP("PXKENC",$J, array
+13 ;finishes the ^TMP("PXKCO",$J array
DO COEVENT^PXKENC(PXKVVST)
+14 DO EN^XQOR
+15 DO FINAL^SCDXHLDR(PXKVVST,$GET(PXKVST))
UPD ;UP DATE VISIT FILE
+1 ;--REMOVE CHECK OUT DATE TIME
+2 NEW VSIT
+3 IF $DATA(PXKVVST)
IF $DATA(^AUPNVSIT(PXKVVST))
SET VSIT("IEN")=PXKVVST
SET VSIT("COD")="@"
DO UPD^VSIT
+4 KILL ^TMP("PXKCO",$JOB),PXKVVST,PXKCO,VSIT
+5 KILL ^TMP("PXKENC",$JOB)
+6 QUIT
