VAQPST40 ;JRP/ALB - UPDATE DATA SEGMENT FILE;09-SEP-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
UPDATE ;MAIN ENTRY POINT
;INPUT : NONE
;OUTPUT : NONE
;
;DECLARE VARIABLES
N NODE,SEGPTR,HLTHSEG,DEFTIM,DEFOCC,TIMLIM,OCCLIM,TMP
N HLTHPTR,HLTHABB,CURTIM,CUROCC,COUNT
S DEFTIM=""
S DEFOCC=""
;GET DEFAULT TIME & OCCURANCE LIMIT FROM PARAMETER FILE
S TMP=+$O(^VAT(394.81,0))
I (TMP) D
.S NODE=$G(^VAT(394.81,TMP,"LIMITS"))
.S DEFTIM=$P(NODE,"^",1)
.S DEFOCC=$P(NODE,"^",2)
;DEFAULTS NOT SET - USE 1 YEAR & 10 OCCURRENCES
S:(DEFTIM="") DEFTIM="1Y"
S:('DEFOCC) DEFOCC=10
;LOOP THROUGH HEALTH SUMMARY COMPONENTS
W !!!,"Updating pointers to Health Summary components and initializing"
W !,"maximum time and occurrence limits (when appropriate) "
S COUNT=0
S HLTHABB=""
F S HLTHABB=$O(^GMT(142.1,"C",HLTHABB)) Q:(HLTHABB="") D
.S HLTHPTR=+$O(^GMT(142.1,"C",HLTHABB,0))
.Q:('HLTHPTR)
.S COUNT=COUNT+1
.W:('(COUNT#5)) "."
.;FIND ENTRY IN DATA SEGMENT FILE
.S SEGPTR=+$O(^VAT(394.71,"C",HLTHABB,0))
.Q:('SEGPTR)
.;DETERMINE IF LIMITS ARE APPLICABLE
.S TMP=$$LIMITS^VAQDBIH1(HLTHPTR)
.S TIMLIM=+$P(TMP,"^",1)
.S OCCLIM=+$P(TMP,"^",2)
.;GET DATA SEGMENT NODE CONTAINING HEALTH SUMMARY INFO
.S NODE=$G(^VAT(394.71,SEGPTR,0))
.;SET POINTER TO HEALTH SUMMARY COMPONENT
.S $P(NODE,"^",4)=HLTHPTR
.;GET CURRENT TIME & OCCURRENCE MAX VALUES
.S CURTIM=$P(NODE,"^",5)
.S CUROCC=$P(NODE,"^",6)
.;SET MAXIMUM TIME LIMIT - USE CURRENT VALUE IF THERE
.I (TIMLIM) S:(CURTIM="") CURTIM=DEFTIM
.;TIME LIMIT NOT APPLICABLE
.I ('TIMLIM) S CURTIM=""
.;SET MAXIMUM OCCURRENCE LIMIT - USE CURRENT VALUE IF THERE
.I (OCCLIM) S:(CUROCC="") CUROCC=DEFOCC
.;OCCURRENCE LIMIT NOT APPLICABLE
.I ('OCCLIM) S CUROCC=""
.;STORE MAXIMUM LIMITS
.S $P(NODE,"^",5)=CURTIM
.S $P(NODE,"^",6)=CUROCC
.S ^VAT(394.71,SEGPTR,0)=NODE
;DONE
W !!,"Updating completed",!!!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQPST40 1936 printed Sep 23, 2025@20:02:15 Page 2
VAQPST40 ;JRP/ALB - UPDATE DATA SEGMENT FILE;09-SEP-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
UPDATE ;MAIN ENTRY POINT
+1 ;INPUT : NONE
+2 ;OUTPUT : NONE
+3 ;
+4 ;DECLARE VARIABLES
+5 NEW NODE,SEGPTR,HLTHSEG,DEFTIM,DEFOCC,TIMLIM,OCCLIM,TMP
+6 NEW HLTHPTR,HLTHABB,CURTIM,CUROCC,COUNT
+7 SET DEFTIM=""
+8 SET DEFOCC=""
+9 ;GET DEFAULT TIME & OCCURANCE LIMIT FROM PARAMETER FILE
+10 SET TMP=+$ORDER(^VAT(394.81,0))
+11 IF (TMP)
Begin DoDot:1
+12 SET NODE=$GET(^VAT(394.81,TMP,"LIMITS"))
+13 SET DEFTIM=$PIECE(NODE,"^",1)
+14 SET DEFOCC=$PIECE(NODE,"^",2)
End DoDot:1
+15 ;DEFAULTS NOT SET - USE 1 YEAR & 10 OCCURRENCES
+16 if (DEFTIM="")
SET DEFTIM="1Y"
+17 if ('DEFOCC)
SET DEFOCC=10
+18 ;LOOP THROUGH HEALTH SUMMARY COMPONENTS
+19 WRITE !!!,"Updating pointers to Health Summary components and initializing"
+20 WRITE !,"maximum time and occurrence limits (when appropriate) "
+21 SET COUNT=0
+22 SET HLTHABB=""
+23 FOR
SET HLTHABB=$ORDER(^GMT(142.1,"C",HLTHABB))
if (HLTHABB="")
QUIT
Begin DoDot:1
+24 SET HLTHPTR=+$ORDER(^GMT(142.1,"C",HLTHABB,0))
+25 if ('HLTHPTR)
QUIT
+26 SET COUNT=COUNT+1
+27 if ('(COUNT#5))
WRITE "."
+28 ;FIND ENTRY IN DATA SEGMENT FILE
+29 SET SEGPTR=+$ORDER(^VAT(394.71,"C",HLTHABB,0))
+30 if ('SEGPTR)
QUIT
+31 ;DETERMINE IF LIMITS ARE APPLICABLE
+32 SET TMP=$$LIMITS^VAQDBIH1(HLTHPTR)
+33 SET TIMLIM=+$PIECE(TMP,"^",1)
+34 SET OCCLIM=+$PIECE(TMP,"^",2)
+35 ;GET DATA SEGMENT NODE CONTAINING HEALTH SUMMARY INFO
+36 SET NODE=$GET(^VAT(394.71,SEGPTR,0))
+37 ;SET POINTER TO HEALTH SUMMARY COMPONENT
+38 SET $PIECE(NODE,"^",4)=HLTHPTR
+39 ;GET CURRENT TIME & OCCURRENCE MAX VALUES
+40 SET CURTIM=$PIECE(NODE,"^",5)
+41 SET CUROCC=$PIECE(NODE,"^",6)
+42 ;SET MAXIMUM TIME LIMIT - USE CURRENT VALUE IF THERE
+43 IF (TIMLIM)
if (CURTIM="")
SET CURTIM=DEFTIM
+44 ;TIME LIMIT NOT APPLICABLE
+45 IF ('TIMLIM)
SET CURTIM=""
+46 ;SET MAXIMUM OCCURRENCE LIMIT - USE CURRENT VALUE IF THERE
+47 IF (OCCLIM)
if (CUROCC="")
SET CUROCC=DEFOCC
+48 ;OCCURRENCE LIMIT NOT APPLICABLE
+49 IF ('OCCLIM)
SET CUROCC=""
+50 ;STORE MAXIMUM LIMITS
+51 SET $PIECE(NODE,"^",5)=CURTIM
+52 SET $PIECE(NODE,"^",6)=CUROCC
+53 SET ^VAT(394.71,SEGPTR,0)=NODE
End DoDot:1
+54 ;DONE
+55 WRITE !!,"Updating completed",!!!
+56 QUIT
