VSITPUT ;ISD/RJP - Verify/Set Fields and File Visit Record ;Aug 04, 2025@08:53:48
;;1.0;PCE PATIENT CARE ENCOUNTER;**76,244**;Aug 12, 1996;Build 37
; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
; the incorporation of the module into PCE. For historical reference,
; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
; patches.
;
;;2.0;VISIT TRACKING;;Aug 12, 1996;
;
; - verify/set visit record fields
; - called by ^VSIT
;
N FLD,FLDINDX,VSITREC
S FLDINDX=""
F S FLDINDX=$O(^TMP("VSITDD",$J,FLDINDX)) Q:FLDINDX="" D
. S FLD=^TMP("VSITDD",$J,FLDINDX)
. S:$P(VSIT(FLDINDX),"^")]"" $P(VSITREC($P(FLD,";",3)),"^",$P(FLD,";",4))=$P(VSIT(FLDINDX),"^")
;
I +$D(^TMP("PXK",$J,"VST",1,900,"AFTER")) D
. N IND S IND=0
. F S IND=+$O(^TMP("PXK",$J,"VST",1,900,"AFTER",IND)) Q:IND=0 D
.. S VSITREC(900,IND,0)=^TMP("PXK",$J,"VST",1,900,"AFTER",IND,0)
;
Q:'$D(VSITREC(0))
;
D ^VSITPUT1
;
QUIT ; - exit
Q
ERR(ERR) ; - send error bulletin
; sent at QUIT^VSIT
; mail group = vsit create error
;
D VAR^VSITBUL(ERR)
Q
;
WRN(ERR) ; - send warning bulletin
; sent at QUIT^VSIT
; mail group = vsit create error
D VAR^VSITBUL(ERR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVSITPUT 1252 printed Jul 11, 2026@02:29:01 Page 2
VSITPUT ;ISD/RJP - Verify/Set Fields and File Visit Record ;Aug 04, 2025@08:53:48
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**76,244**;Aug 12, 1996;Build 37
+2 ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
+3 ; the incorporation of the module into PCE. For historical reference,
+4 ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
+5 ; patches.
+6 ;
+7 ;;2.0;VISIT TRACKING;;Aug 12, 1996;
+8 ;
+9 ; - verify/set visit record fields
+10 ; - called by ^VSIT
+11 ;
+12 NEW FLD,FLDINDX,VSITREC
+13 SET FLDINDX=""
+14 FOR
SET FLDINDX=$ORDER(^TMP("VSITDD",$JOB,FLDINDX))
if FLDINDX=""
QUIT
Begin DoDot:1
+15 SET FLD=^TMP("VSITDD",$JOB,FLDINDX)
+16 if $PIECE(VSIT(FLDINDX),"^")]""
SET $PIECE(VSITREC($PIECE(FLD,";",3)),"^",$PIECE(FLD,";",4))=$PIECE(VSIT(FLDINDX),"^")
End DoDot:1
+17 ;
+18 IF +$DATA(^TMP("PXK",$JOB,"VST",1,900,"AFTER"))
Begin DoDot:1
+19 NEW IND
SET IND=0
+20 FOR
SET IND=+$ORDER(^TMP("PXK",$JOB,"VST",1,900,"AFTER",IND))
if IND=0
QUIT
Begin DoDot:2
+21 SET VSITREC(900,IND,0)=^TMP("PXK",$JOB,"VST",1,900,"AFTER",IND,0)
End DoDot:2
End DoDot:1
+22 ;
+23 if '$DATA(VSITREC(0))
QUIT
+24 ;
+25 DO ^VSITPUT1
+26 ;
QUIT ; - exit
+1 QUIT
ERR(ERR) ; - send error bulletin
+1 ; sent at QUIT^VSIT
+2 ; mail group = vsit create error
+3 ;
+4 DO VAR^VSITBUL(ERR)
+5 QUIT
+6 ;
WRN(ERR) ; - send warning bulletin
+1 ; sent at QUIT^VSIT
+2 ; mail group = vsit create error
+3 DO VAR^VSITBUL(ERR)
+4 QUIT
