PXKVST ;ISL/ARS - SET UP VISIT FIELDS BEFORE CALLING OFF TO VSIT ;Dec 15, 2025@09:35:18
;;1.0;PCE PATIENT CARE ENCOUNTER;**56,111,130,164,168,211,238,244**;Aug 12, 1996;Build 37
;
; Reference to File ^SC( in ICR #1295
;
Q
VSIT ;ENTRY POINT
;COMMON SECTION
N PXKAFTR,PXKAFT8,PXKAFT15,PXKAFT21,PXKAF811,PXKAF812,PXVSTIEN
N VSIT,VSITPKG
S PXKAFTR=$G(^TMP("PXK",$J,"VST",1,0,"AFTER"))
Q:PXKAFTR=""
S PXKAFT21=$G(^TMP("PXK",$J,"VST",1,21,"AFTER"))
S PXKAFT15=$G(^TMP("PXK",$J,"VST",1,150,"AFTER"))
S PXKAFT8=$G(^TMP("PXK",$J,"VST",1,800,"AFTER"))
S PXKAF811=$G(^TMP("PXK",$J,"VST",1,811,"AFTER"))
S PXKAF812=$G(^TMP("PXK",$J,"VST",1,812,"AFTER"))
S VSIT("IEN")=$G(^TMP("PXK",$J,"VST",1,"IEN"))
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"
;If ^TMP("PXK",$J,"VISITCREATE")="F" then in CALL^PXAIVST, FINDVISIT^PXUTLVST could not find an existing visit so
;force the creation of a new one.
I $G(^TMP("PXK",$J,"VISITCREATE"))="F" S VSIT(0)=$S(VSIT("SVC")="E":"F",1:"EF")
I '$D(VSIT(0)) 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)
;W !,"VSIT^PXKVST SETTING ^TMP(PXK) BEFORE AND AFTER" BREAK
;Building the "BEFORE" here is not necessary, they were already
;built in PXIAVST, commenting them out in PX*1.0*244.
;If the third piece of VSIT("IEN")=1 the entry was just added.
I $P(VSIT("IEN"),"^",3)'=1 D
.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))
.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 4259 printed Jul 11, 2026@02:25:55 Page 2
PXKVST ;ISL/ARS - SET UP VISIT FIELDS BEFORE CALLING OFF TO VSIT ;Dec 15, 2025@09:35:18
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**56,111,130,164,168,211,238,244**;Aug 12, 1996;Build 37
+2 ;
+3 ; Reference to File ^SC( in ICR #1295
+4 ;
+5 QUIT
VSIT ;ENTRY POINT
+1 ;COMMON SECTION
+2 NEW PXKAFTR,PXKAFT8,PXKAFT15,PXKAFT21,PXKAF811,PXKAF812,PXVSTIEN
+3 NEW VSIT,VSITPKG
+4 SET PXKAFTR=$GET(^TMP("PXK",$JOB,"VST",1,0,"AFTER"))
+5 if PXKAFTR=""
QUIT
+6 SET PXKAFT21=$GET(^TMP("PXK",$JOB,"VST",1,21,"AFTER"))
+7 SET PXKAFT15=$GET(^TMP("PXK",$JOB,"VST",1,150,"AFTER"))
+8 SET PXKAFT8=$GET(^TMP("PXK",$JOB,"VST",1,800,"AFTER"))
+9 SET PXKAF811=$GET(^TMP("PXK",$JOB,"VST",1,811,"AFTER"))
+10 SET PXKAF812=$GET(^TMP("PXK",$JOB,"VST",1,812,"AFTER"))
+11 SET VSIT("IEN")=$GET(^TMP("PXK",$JOB,"VST",1,"IEN"))
+12 IF VSIT("IEN")=""
SET PXKAFTR=$TRANSLATE(PXKAFTR,"@")
SET PXKAFT8=$TRANSLATE(PXKAFT8,"@")
+13 ;
+14 SET VSIT("VDT")=$SELECT($PIECE(PXKAFTR,"^",1)]"":$PIECE(PXKAFTR,"^",1),1:"NOW")
+15 SET VSIT("TYP")=$PIECE(PXKAFTR,"^",3)
+16 SET VSIT("INS")=$PIECE(PXKAFTR,"^",6)
+17 SET VSIT("OUT")=$PIECE(PXKAFT21,"^")
+18 SET VSIT("PAT")=$PIECE(PXKAFTR,"^",5)
+19 SET VSIT("SVC")=$PIECE(PXKAFTR,"^",7)
+20 SET VSIT("DSS")=$PIECE(PXKAFTR,"^",8)
+21 SET VSIT("LNK")=$PIECE(PXKAFTR,"^",12)
+22 SET VSIT("WIA")=$PIECE(PXKAFTR,"^",16)
+23 SET VSIT("LOS")=$PIECE(PXKAFTR,"^",17)
+24 SET VSIT("COD")=$PIECE(PXKAFTR,"^",18)
+25 if $PIECE(PXKAFTR,"^",21)]""
SET VSIT("ELG")=$PIECE(PXKAFTR,"^",21)
+26 SET VSIT("LOC")=$PIECE(PXKAFTR,"^",22)
+27 SET VSIT("USR")=$PIECE(PXKAFTR,"^",23)
+28 ;PX*1.0*164
SET VSIT("ACT")=$PIECE(PXKAFTR,"^",26)
+29 if $PIECE(PXKAFT8,"^",1)]""
SET VSIT("SC")=$PIECE(PXKAFT8,"^",1)
+30 if $PIECE(PXKAFT8,"^",2)]""
SET VSIT("AO")=$PIECE(PXKAFT8,"^",2)
+31 if $PIECE(PXKAFT8,"^",3)]""
SET VSIT("IR")=$PIECE(PXKAFT8,"^",3)
+32 if $PIECE(PXKAFT8,"^",4)]""
SET VSIT("EC")=$PIECE(PXKAFT8,"^",4)
+33 ;added 6/17/98 for MST enhancement
if $PIECE(PXKAFT8,"^",5)]""
SET VSIT("MST")=$PIECE(PXKAFT8,"^",5)
+34 ;PX*1*111 - added for HNC enhancement
+35 if $PIECE(PXKAFT8,"^",6)]""
SET VSIT("HNC")=$PIECE(PXKAFT8,"^",6)
+36 if $PIECE(PXKAFT8,"^",7)]""
SET VSIT("CV")=$PIECE(PXKAFT8,"^",7)
+37 if $PIECE(PXKAFT8,"^",8)]""
SET VSIT("SHAD")=$PIECE(PXKAFT8,"^",8)
+38 if $PIECE(PXKAFT15,"^",1)]""
SET VSIT("SVP")=$PIECE(PXKAFT15,"^",1)
+39 if $PIECE(PXKAFT15,"^",2)]""
SET VSIT("IO")=$PIECE(PXKAFT15,"^",2)
+40 if $PIECE(PXKAFT15,"^",3)]""
SET VSIT("PRI")=$PIECE(PXKAFT15,"^",3)
+41 if $PIECE(PXKAF812,"^",2)]""
SET VSIT("PKG")=$PIECE(PXKAF812,"^",2)
+42 if $PIECE(PXKAF812,"^",3)]""
SET VSIT("SOR")=$PIECE(PXKAF812,"^",3)
+43 if PXKAF811]""
SET VSIT("COM")=PXKAF811
+44 SET VSITPKG=$GET(VSIT("PKG"))
+45 IF $GET(VSIT("PRI"))=""
IF VSIT("SVC")="E"!($PIECE($GET(^SC(+VSIT("LOC"),0)),"^",7)=VSIT("DSS"))
SET VSIT("PRI")="P"
+46 ;If ^TMP("PXK",$J,"VISITCREATE")="F" then in CALL^PXAIVST, FINDVISIT^PXUTLVST could not find an existing visit so
+47 ;force the creation of a new one.
+48 IF $GET(^TMP("PXK",$JOB,"VISITCREATE"))="F"
SET VSIT(0)=$SELECT(VSIT("SVC")="E":"F",1:"EF")
+49 IF '$DATA(VSIT(0))
SET VSIT(0)=$SELECT(VSIT("SVC")="E":"D0NM",1:"D0NEM")
+50 ;
+51 ;CALL FOR VSIT
+52 DO ^VSIT
+53 IF '$DATA(VSIT("IEN"))#2
QUIT
+54 SET PXVSTIEN=$PIECE(VSIT("IEN"),"^",1)
+55 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=PXVSTIEN
+56 IF PXVSTIEN<1
QUIT
+57 DO VIEN(PXVSTIEN)
+58 ;W !,"VSIT^PXKVST SETTING ^TMP(PXK) BEFORE AND AFTER" BREAK
+59 ;Building the "BEFORE" here is not necessary, they were already
+60 ;built in PXIAVST, commenting them out in PX*1.0*244.
+61 ;If the third piece of VSIT("IEN")=1 the entry was just added.
+62 IF $PIECE(VSIT("IEN"),"^",3)'=1
Begin DoDot:1
+63 SET $PIECE(^TMP("PXK",$JOB,"VST",1,0,"AFTER"),"^",3)=$PIECE(^AUPNVSIT(PXVSTIEN,0),"^",3)
+64 SET $PIECE(^TMP("PXK",$JOB,"VST",1,0,"AFTER"),"^",7)=$PIECE(^AUPNVSIT(PXVSTIEN,0),"^",7)
End DoDot:1
+65 IF $PIECE(VSIT("IEN"),"^",3)=1
Begin DoDot:1
+66 SET ^TMP("PXK",$JOB,"VST",1,0,"AFTER")=^AUPNVSIT(PXVSTIEN,0)
+67 SET ^TMP("PXK",$JOB,"VST",1,21,"AFTER")=$GET(^AUPNVSIT(PXVSTIEN,21))
+68 SET ^TMP("PXK",$JOB,"VST",1,150,"AFTER")=$GET(^AUPNVSIT(PXVSTIEN,150))
+69 SET ^TMP("PXK",$JOB,"VST",1,800,"AFTER")=$GET(^AUPNVSIT(PXVSTIEN,800))
+70 SET ^TMP("PXK",$JOB,"VST",1,811,"AFTER")=$GET(^AUPNVSIT(PXVSTIEN,811))
+71 SET ^TMP("PXK",$JOB,"VST",1,812,"AFTER")=$GET(^AUPNVSIT(PXVSTIEN,812))
+72 IF $DATA(PXELAP)#2
Begin DoDot:2
+73 SET ^TMP("PXKCO",$JOB,PXVSTIEN,"VST",PXVSTIEN,"ELAP","BEFORE")=""
+74 SET ^TMP("PXKCO",$JOB,PXVSTIEN,"VST",PXVSTIEN,"ELAP","AFTER")=PXELAP
End DoDot:2
End DoDot:1
+75 KILL VSIT
+76 QUIT
+77 ;
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 ;
