PXKVST ;ISL/ARS - SET UP VISIT FIELDS BEFORE CALLING OFF TO VSIT ;05/10/2018
;;1.0;PCE PATIENT CARE ENCOUNTER;**56,111,130,164,168,211**;Aug 12, 1996;Build 454
VSIT ;ENTRY POINT
;COMMON SECTION
N PXKAFTR,PXKAFT8,PXKAFT15,PXKAFT21,PXKAF811,PXKAF812,PXVSTIEN
N VSIT,VSITPKG
S PXKAFTR=$S($G(^TMP("PXK",$J,"VST",1,0,"AFTER"))]"":^TMP("PXK",$J,"VST",1,0,"AFTER"),1:"")
Q:PXKAFTR=""
S PXKAFT21=$S($G(^TMP("PXK",$J,"VST",1,21,"AFTER"))]"":^TMP("PXK",$J,"VST",1,21,"AFTER"),1:"")
S PXKAFT15=$S($G(^TMP("PXK",$J,"VST",1,150,"AFTER"))]"":^TMP("PXK",$J,"VST",1,150,"AFTER"),1:"")
S PXKAFT8=$S($G(^TMP("PXK",$J,"VST",1,800,"AFTER"))]"":^TMP("PXK",$J,"VST",1,800,"AFTER"),1:"")
S PXKAF811=$S($G(^TMP("PXK",$J,"VST",1,811,"AFTER"))]"":^TMP("PXK",$J,"VST",1,811,"AFTER"),1:"")
S PXKAF812=$S($G(^TMP("PXK",$J,"VST",1,812,"AFTER"))]"":^TMP("PXK",$J,"VST",1,812,"AFTER"),1:"")
S VSIT("IEN")=$S(^TMP("PXK",$J,"VST",1,"IEN")]"":^TMP("PXK",$J,"VST",1,"IEN"),1:"")
I VSIT("IEN")="" S PXKAFTR=$TR(PXKAFTR,"@"),PXKAFT8=$TR(PXKAFT8,"@")
S VSIT("VDT")=$S($P(PXKAFTR,"^",1)]"":$P(PXKAFTR,"^",1),1:"NOW")
S VSIT("TYP")=$P(PXKAFTR,"^",3)
S VSIT("INS")=$P(PXKAFTR,"^",6)
S VSIT("OUT")=$P(PXKAFT21,"^")
S VSIT("PAT")=$P(PXKAFTR,"^",5)
S VSIT("SVC")=$P(PXKAFTR,"^",7)
S VSIT("DSS")=$P(PXKAFTR,"^",8)
S VSIT("LNK")=$P(PXKAFTR,"^",12)
S VSIT("WIA")=$P(PXKAFTR,"^",16)
S VSIT("LOS")=$P(PXKAFTR,"^",17)
S VSIT("COD")=$P(PXKAFTR,"^",18)
S:$P(PXKAFTR,"^",21)]"" VSIT("ELG")=$P(PXKAFTR,"^",21)
S VSIT("LOC")=$P(PXKAFTR,"^",22)
S VSIT("USR")=$P(PXKAFTR,"^",23)
S VSIT("ACT")=$P(PXKAFTR,"^",26) ;PX*1.0*164
S:$P(PXKAFT8,"^",1)]"" VSIT("SC")=$P(PXKAFT8,"^",1)
S:$P(PXKAFT8,"^",2)]"" VSIT("AO")=$P(PXKAFT8,"^",2)
S:$P(PXKAFT8,"^",3)]"" VSIT("IR")=$P(PXKAFT8,"^",3)
S:$P(PXKAFT8,"^",4)]"" VSIT("EC")=$P(PXKAFT8,"^",4)
S:$P(PXKAFT8,"^",5)]"" VSIT("MST")=$P(PXKAFT8,"^",5) ;added 6/17/98 for MST enhancement
;PX*1*111 - added for HNC enhancement
S:$P(PXKAFT8,"^",6)]"" VSIT("HNC")=$P(PXKAFT8,"^",6)
S:$P(PXKAFT8,"^",7)]"" VSIT("CV")=$P(PXKAFT8,"^",7)
S:$P(PXKAFT8,"^",8)]"" VSIT("SHAD")=$P(PXKAFT8,"^",8)
S:$P(PXKAFT15,"^",1)]"" VSIT("SVP")=$P(PXKAFT15,"^",1)
S:$P(PXKAFT15,"^",2)]"" VSIT("IO")=$P(PXKAFT15,"^",2)
S:$P(PXKAFT15,"^",3)]"" VSIT("PRI")=$P(PXKAFT15,"^",3)
S:$P(PXKAF812,"^",2)]"" VSIT("PKG")=$P(PXKAF812,"^",2)
S:$P(PXKAF812,"^",3)]"" VSIT("SOR")=$P(PXKAF812,"^",3)
S:PXKAF811]"" VSIT("COM")=PXKAF811
S VSITPKG=$G(VSIT("PKG"))
I $G(VSIT("PRI"))="",VSIT("SVC")="E"!($P($G(^SC(+VSIT("LOC"),0)),"^",7)=VSIT("DSS")) S VSIT("PRI")="P"
I '$D(VSIT(0)) D
.S VSIT(0)=$S(VSIT("SVC")="E":"D0NM",1:"D0NEM")
;
;CALL FOR VSIT
D ^VSIT
I '$D(VSIT("IEN"))#2 Q
S PXVSTIEN=$P(VSIT("IEN"),"^",1)
S ^TMP("PXK",$J,"VST",1,"IEN")=PXVSTIEN
I PXVSTIEN<1 Q
D VIEN(PXVSTIEN)
I $P(VSIT("IEN"),"^",3)'=1 D
.S ^TMP("PXK",$J,"VST",1,0,"BEFORE")=^AUPNVSIT(PXVSTIEN,0)
.S ^TMP("PXK",$J,"VST",1,21,"BEFORE")=$G(^AUPNVSIT(PXVSTIEN,21))
.S ^TMP("PXK",$J,"VST",1,150,"BEFORE")=$G(^AUPNVSIT(PXVSTIEN,150))
.S ^TMP("PXK",$J,"VST",1,800,"BEFORE")=$G(^AUPNVSIT(PXVSTIEN,800))
.S ^TMP("PXK",$J,"VST",1,811,"BEFORE")=$G(^AUPNVSIT(PXVSTIEN,811))
.S ^TMP("PXK",$J,"VST",1,812,"BEFORE")=$G(^AUPNVSIT(PXVSTIEN,812))
.S $P(^TMP("PXK",$J,"VST",1,0,"AFTER"),"^",3)=$P(^AUPNVSIT(PXVSTIEN,0),"^",3)
.S $P(^TMP("PXK",$J,"VST",1,0,"AFTER"),"^",7)=$P(^AUPNVSIT(PXVSTIEN,0),"^",7)
I $P(VSIT("IEN"),"^",3)=1 D
.S ^TMP("PXK",$J,"VST",1,0,"AFTER")=^AUPNVSIT(PXVSTIEN,0)
.S ^TMP("PXK",$J,"VST",1,21,"AFTER")=$G(^AUPNVSIT(PXVSTIEN,21))
.S ^TMP("PXK",$J,"VST",1,150,"AFTER")=$G(^AUPNVSIT(PXVSTIEN,150))
.S ^TMP("PXK",$J,"VST",1,800,"AFTER")=$G(^AUPNVSIT(PXVSTIEN,800))
.S ^TMP("PXK",$J,"VST",1,811,"AFTER")=$G(^AUPNVSIT(PXVSTIEN,811))
.S ^TMP("PXK",$J,"VST",1,812,"AFTER")=$G(^AUPNVSIT(PXVSTIEN,812))
.S ^TMP("PXK",$J,"VST",1,0,"BEFORE")=""
.S ^TMP("PXK",$J,"VST",1,21,"BEFORE")=""
.S ^TMP("PXK",$J,"VST",1,150,"BEFORE")=""
.S ^TMP("PXK",$J,"VST",1,800,"BEFORE")=""
.S ^TMP("PXK",$J,"VST",1,811,"BEFORE")=""
.S ^TMP("PXK",$J,"VST",1,812,"BEFORE")=""
.I $D(PXELAP)#2 D
..S ^TMP("PXKCO",$J,PXVSTIEN,"VST",PXVSTIEN,"ELAP","BEFORE")=""
..S ^TMP("PXKCO",$J,PXVSTIEN,"VST",PXVSTIEN,"ELAP","AFTER")=PXELAP
K VSIT
Q
;
VIEN(VIEN) ;Put the Visit IEN in the AFTERs for all of the V-Files
N PXCAINX1,PXCAINX2
S PXCAINX1=""
F S PXCAINX1=$O(^TMP("PXK",$J,PXCAINX1)) Q:PXCAINX1']"" D:"^VST^SOR^"'[PXCAINX1
. S PXCAINX2=""
. F S PXCAINX2=$O(^TMP("PXK",$J,PXCAINX1,PXCAINX2)) Q:PXCAINX2']"" D
.. I $D(^TMP("PXK",$J,PXCAINX1,PXCAINX2,0,"AFTER"))=1 S $P(^TMP("PXK",$J,PXCAINX1,PXCAINX2,0,"AFTER"),"^",3)=VIEN
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXKVST 4689 printed Apr 09, 2024@21:33:53 Page 2
PXKVST ;ISL/ARS - SET UP VISIT FIELDS BEFORE CALLING OFF TO VSIT ;05/10/2018
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**56,111,130,164,168,211**;Aug 12, 1996;Build 454
VSIT ;ENTRY POINT
+1 ;COMMON SECTION
+2 NEW PXKAFTR,PXKAFT8,PXKAFT15,PXKAFT21,PXKAF811,PXKAF812,PXVSTIEN
+3 NEW VSIT,VSITPKG
+4 SET PXKAFTR=$SELECT($GET(^TMP("PXK",$JOB,"VST",1,0,"AFTER"))]"":^TMP("PXK",$JOB,"VST",1,0,"AFTER"),1:"")
+5 if PXKAFTR=""
QUIT
+6 SET PXKAFT21=$SELECT($GET(^TMP("PXK",$JOB,"VST",1,21,"AFTER"))]"":^TMP("PXK",$JOB,"VST",1,21,"AFTER"),1:"")
+7 SET PXKAFT15=$SELECT($GET(^TMP("PXK",$JOB,"VST",1,150,"AFTER"))]"":^TMP("PXK",$JOB,"VST",1,150,"AFTER"),1:"")
+8 SET PXKAFT8=$SELECT($GET(^TMP("PXK",$JOB,"VST",1,800,"AFTER"))]"":^TMP("PXK",$JOB,"VST",1,800,"AFTER"),1:"")
+9 SET PXKAF811=$SELECT($GET(^TMP("PXK",$JOB,"VST",1,811,"AFTER"))]"":^TMP("PXK",$JOB,"VST",1,811,"AFTER"),1:"")
+10 SET PXKAF812=$SELECT($GET(^TMP("PXK",$JOB,"VST",1,812,"AFTER"))]"":^TMP("PXK",$JOB,"VST",1,812,"AFTER"),1:"")
+11 SET VSIT("IEN")=$SELECT(^TMP("PXK",$JOB,"VST",1,"IEN")]"":^TMP("PXK",$JOB,"VST",1,"IEN"),1:"")
+12 IF VSIT("IEN")=""
SET PXKAFTR=$TRANSLATE(PXKAFTR,"@")
SET PXKAFT8=$TRANSLATE(PXKAFT8,"@")
+13 SET VSIT("VDT")=$SELECT($PIECE(PXKAFTR,"^",1)]"":$PIECE(PXKAFTR,"^",1),1:"NOW")
+14 SET VSIT("TYP")=$PIECE(PXKAFTR,"^",3)
+15 SET VSIT("INS")=$PIECE(PXKAFTR,"^",6)
+16 SET VSIT("OUT")=$PIECE(PXKAFT21,"^")
+17 SET VSIT("PAT")=$PIECE(PXKAFTR,"^",5)
+18 SET VSIT("SVC")=$PIECE(PXKAFTR,"^",7)
+19 SET VSIT("DSS")=$PIECE(PXKAFTR,"^",8)
+20 SET VSIT("LNK")=$PIECE(PXKAFTR,"^",12)
+21 SET VSIT("WIA")=$PIECE(PXKAFTR,"^",16)
+22 SET VSIT("LOS")=$PIECE(PXKAFTR,"^",17)
+23 SET VSIT("COD")=$PIECE(PXKAFTR,"^",18)
+24 if $PIECE(PXKAFTR,"^",21)]""
SET VSIT("ELG")=$PIECE(PXKAFTR,"^",21)
+25 SET VSIT("LOC")=$PIECE(PXKAFTR,"^",22)
+26 SET VSIT("USR")=$PIECE(PXKAFTR,"^",23)
+27 ;PX*1.0*164
SET VSIT("ACT")=$PIECE(PXKAFTR,"^",26)
+28 if $PIECE(PXKAFT8,"^",1)]""
SET VSIT("SC")=$PIECE(PXKAFT8,"^",1)
+29 if $PIECE(PXKAFT8,"^",2)]""
SET VSIT("AO")=$PIECE(PXKAFT8,"^",2)
+30 if $PIECE(PXKAFT8,"^",3)]""
SET VSIT("IR")=$PIECE(PXKAFT8,"^",3)
+31 if $PIECE(PXKAFT8,"^",4)]""
SET VSIT("EC")=$PIECE(PXKAFT8,"^",4)
+32 ;added 6/17/98 for MST enhancement
if $PIECE(PXKAFT8,"^",5)]""
SET VSIT("MST")=$PIECE(PXKAFT8,"^",5)
+33 ;PX*1*111 - added for HNC enhancement
+34 if $PIECE(PXKAFT8,"^",6)]""
SET VSIT("HNC")=$PIECE(PXKAFT8,"^",6)
+35 if $PIECE(PXKAFT8,"^",7)]""
SET VSIT("CV")=$PIECE(PXKAFT8,"^",7)
+36 if $PIECE(PXKAFT8,"^",8)]""
SET VSIT("SHAD")=$PIECE(PXKAFT8,"^",8)
+37 if $PIECE(PXKAFT15,"^",1)]""
SET VSIT("SVP")=$PIECE(PXKAFT15,"^",1)
+38 if $PIECE(PXKAFT15,"^",2)]""
SET VSIT("IO")=$PIECE(PXKAFT15,"^",2)
+39 if $PIECE(PXKAFT15,"^",3)]""
SET VSIT("PRI")=$PIECE(PXKAFT15,"^",3)
+40 if $PIECE(PXKAF812,"^",2)]""
SET VSIT("PKG")=$PIECE(PXKAF812,"^",2)
+41 if $PIECE(PXKAF812,"^",3)]""
SET VSIT("SOR")=$PIECE(PXKAF812,"^",3)
+42 if PXKAF811]""
SET VSIT("COM")=PXKAF811
+43 SET VSITPKG=$GET(VSIT("PKG"))
+44 IF $GET(VSIT("PRI"))=""
IF VSIT("SVC")="E"!($PIECE($GET(^SC(+VSIT("LOC"),0)),"^",7)=VSIT("DSS"))
SET VSIT("PRI")="P"
+45 IF '$DATA(VSIT(0))
Begin DoDot:1
+46 SET VSIT(0)=$SELECT(VSIT("SVC")="E":"D0NM",1:"D0NEM")
End DoDot:1
+47 ;
+48 ;CALL FOR VSIT
+49 DO ^VSIT
+50 IF '$DATA(VSIT("IEN"))#2
QUIT
+51 SET PXVSTIEN=$PIECE(VSIT("IEN"),"^",1)
+52 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=PXVSTIEN
+53 IF PXVSTIEN<1
QUIT
+54 DO VIEN(PXVSTIEN)
+55 IF $PIECE(VSIT("IEN"),"^",3)'=1
Begin DoDot:1
+56 SET ^TMP("PXK",$JOB,"VST",1,0,"BEFORE")=^AUPNVSIT(PXVSTIEN,0)
+57 SET ^TMP("PXK",$JOB,"VST",1,21,"BEFORE")=$GET(^AUPNVSIT(PXVSTIEN,21))
+58 SET ^TMP("PXK",$JOB,"VST",1,150,"BEFORE")=$GET(^AUPNVSIT(PXVSTIEN,150))
+59 SET ^TMP("PXK",$JOB,"VST",1,800,"BEFORE")=$GET(^AUPNVSIT(PXVSTIEN,800))
+60 SET ^TMP("PXK",$JOB,"VST",1,811,"BEFORE")=$GET(^AUPNVSIT(PXVSTIEN,811))
+61 SET ^TMP("PXK",$JOB,"VST",1,812,"BEFORE")=$GET(^AUPNVSIT(PXVSTIEN,812))
+62 SET $PIECE(^TMP("PXK",$JOB,"VST",1,0,"AFTER"),"^",3)=$PIECE(^AUPNVSIT(PXVSTIEN,0),"^",3)
+63 SET $PIECE(^TMP("PXK",$JOB,"VST",1,0,"AFTER"),"^",7)=$PIECE(^AUPNVSIT(PXVSTIEN,0),"^",7)
End DoDot:1
+64 IF $PIECE(VSIT("IEN"),"^",3)=1
Begin DoDot:1
+65 SET ^TMP("PXK",$JOB,"VST",1,0,"AFTER")=^AUPNVSIT(PXVSTIEN,0)
+66 SET ^TMP("PXK",$JOB,"VST",1,21,"AFTER")=$GET(^AUPNVSIT(PXVSTIEN,21))
+67 SET ^TMP("PXK",$JOB,"VST",1,150,"AFTER")=$GET(^AUPNVSIT(PXVSTIEN,150))
+68 SET ^TMP("PXK",$JOB,"VST",1,800,"AFTER")=$GET(^AUPNVSIT(PXVSTIEN,800))
+69 SET ^TMP("PXK",$JOB,"VST",1,811,"AFTER")=$GET(^AUPNVSIT(PXVSTIEN,811))
+70 SET ^TMP("PXK",$JOB,"VST",1,812,"AFTER")=$GET(^AUPNVSIT(PXVSTIEN,812))
+71 SET ^TMP("PXK",$JOB,"VST",1,0,"BEFORE")=""
+72 SET ^TMP("PXK",$JOB,"VST",1,21,"BEFORE")=""
+73 SET ^TMP("PXK",$JOB,"VST",1,150,"BEFORE")=""
+74 SET ^TMP("PXK",$JOB,"VST",1,800,"BEFORE")=""
+75 SET ^TMP("PXK",$JOB,"VST",1,811,"BEFORE")=""
+76 SET ^TMP("PXK",$JOB,"VST",1,812,"BEFORE")=""
+77 IF $DATA(PXELAP)#2
Begin DoDot:2
+78 SET ^TMP("PXKCO",$JOB,PXVSTIEN,"VST",PXVSTIEN,"ELAP","BEFORE")=""
+79 SET ^TMP("PXKCO",$JOB,PXVSTIEN,"VST",PXVSTIEN,"ELAP","AFTER")=PXELAP
End DoDot:2
End DoDot:1
+80 KILL VSIT
+81 QUIT
+82 ;
VIEN(VIEN) ;Put the Visit IEN in the AFTERs for all of the V-Files
+1 NEW PXCAINX1,PXCAINX2
+2 SET PXCAINX1=""
+3 FOR
SET PXCAINX1=$ORDER(^TMP("PXK",$JOB,PXCAINX1))
if PXCAINX1']""
QUIT
if "^VST^SOR^"'[PXCAINX1
Begin DoDot:1
+4 SET PXCAINX2=""
+5 FOR
SET PXCAINX2=$ORDER(^TMP("PXK",$JOB,PXCAINX1,PXCAINX2))
if PXCAINX2']""
QUIT
Begin DoDot:2
+6 IF $DATA(^TMP("PXK",$JOB,PXCAINX1,PXCAINX2,0,"AFTER"))=1
SET $PIECE(^TMP("PXK",$JOB,PXCAINX1,PXCAINX2,0,"AFTER"),"^",3)=VIEN
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
