VAQLED02 ;ALB/JFP - PDX, LOAD/EDIT,SETUP OF DIFFERENCES;01MAR93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
EP ; -- Main entry point for the list processor
; -- K XQORS,VALMEVL ;(only kill on the first screen in)
;
;D CLEAR^VALM1
S VAQBCK=0
D MAIN^VAQLED04 ; -- collects PDX data and MAS data
I '$D(^TMP("VAQTR",$J))!('$D(^TMP("VAQPT",$J))) D QUIT
.W !," Error...No data collected"
.S VAQFLAG=1 D TRANEX
D EN^VALM("VAQ LED DIFFERENCES PDX6")
QUIT
;
INIT ; -- Builds array of differences between PDX minimal and the local
; data stored in file 2.
;
K ^TMP("VAQL2",$J)
K ^TMP("VAQPT",$J,"ID"),^TMP("VAQTR",$J,"ID"),^TMP("VAQLD",$J)
D EP^VAQLED05
QUIT
;
HD ; -- Make header line for list processor
D HD1^VAQEXT02 QUIT
;
FIELD ; -- Updates local patient file by field or fields selected
S (VAQFLAG,VAQUPDFL)=0
D SEL^VALM2
Q:'$D(VALMY)
D CLEAR^VALM1
S ENTRY="" K ^TMP("VAQLD",$J)
F S ENTRY=$O(VALMY(ENTRY)) Q:ENTRY="" D
.S SDAT=$G(^TMP("VAQIDX",$J,ENTRY))
.D UPDATE
I VAQUPDFL=1 D WORKLD
D EP1^VAQLED05 ; -- Redisplay
S VALMBCK="R"
S VAQBCK=1
QUIT
;
UPDATE ; -- Loads fields for update
S DFNTR=$P(SDAT,U,1)
S DFNPT=$P(SDAT,U,2)
I DFNPT="" W !,"Local patient pointer missing... unable to upload field" QUIT
S (FLE,LFLE)=$P(SDAT,U,3)
S FLD=$P(SDAT,U,4)
S SEQ=$P(SDAT,U,5)
S MFLAG=$P(SDAT,U,6)
I LFLE'=2 S LFLE=2 ; -- only lock top level file
S LOCKFLE=$G(^DIC(LFLE,0,"GL"))
L +(@(LOCKFLE_DFNPT_")")):60
I ('$T) W !,"Could not edit entry... record locked" K LOCKFLE QUIT
D:MFLAG="" UPDTER1
D:MFLAG="M" UPDTEM1
L -(@(LOCKFLE_DFNPT_")")) K LOCKFLE
; -- data loaded
S VAQUPDFL=1
I '($D(Y)#2) D KILL QUIT
S ^TMP("VAQLD",$J,ENTRY)=FLE_"^"_FLD ; -- data not pass input transform
QUIT
;
UPDTER1 ; -- Updates patient with PDX data (field by field) ** NON MUTIPLE **
S DIE=$G(^DIC(FLE,0,"GL"))
S DA=DFNPT
S DR=FLD_"///^S X=$G(^TMP(""VAQTR"",$J,""VALUE"",FLE,FLD,0))"
D ^DIE
K DIE,DA,DR
QUIT
;
UPDTEM1 ; -- Updates patient with PDX data (field by field) ** MULTIPLE **
; Loads pointer to main file
S MFLE=$G(^DD(FLE,0,"UP")) ; -- main file
S MFLD="",MFLD=$O(^DD(MFLE,"SB",FLE,MFLD))
S FLD=.01
S DIE=$G(^DIC(MFLE,0,"GL"))
S DA=DFNPT
S DR=MFLD_"///"_$G(^TMP("VAQTR",$J,"VALUE",FLE,FLD,SEQ))
D UPDTEM2
D ^DIE
K DIE,DA,DR,MFLE,MFLD,VALUE
QUIT
;
UPDTEM2 ; -- Load fields into sub file for entry
F S FLD=$O(^TMP("VAQTR",$J,"VALUE",FLE,FLD)) Q:FLD="" D
.S VALUE=FLD_"///"_$G(^TMP("VAQTR",$J,"VALUE",FLE,FLD,SEQ))
.S DR(2,FLE)=VALUE
.S DR(2,FLE,FLD)=VALUE
QUIT
;
LOAD ; -- Loads all different fields from PDX segment to local patient file
I '$D(^TMP("VAQIDX",$J)) S VALMBCK="Q" QUIT
S (VAQFLAG,VAQUPDFL)=0
D CLEAR^VALM1
S ENTRY="" K ^TMP("VAQLD",$J)
F S ENTRY=$O(^TMP("VAQIDX",$J,ENTRY)) Q:ENTRY="" D
.S SDAT=$G(^TMP("VAQIDX",$J,ENTRY))
.D UPDATE
I VAQUPDFL=1 D WORKLD
D EP1^VAQLED05
S VALMBCK="R"
S VAQBCK=1
QUIT
;
TRANEX ; -- Pauses screen
D PAUSE^VALM1
S:'$D(VAQFLAG) VAQFLAG=""
S VALMBCK=$S(VAQFLAG=0:"R",1:"Q")
QUIT
;
WORKLD ; -- Updates workload file for update
S X=$$WORKDONE^VAQADS01("UPDTE",DFNTR,$G(DUZ))
I X<0 W !,"Error updating workload file (UPDTE)... "_$P(X,U,2)
I $P($G(^VAT(394.61,DFNTR,0)),U,4)=0 QUIT
S X=$$WORKDONE^VAQADS01("SNSTVE",DFNTR,$G(DUZ))
I X<0 W !,"Error updating workload file (SNSTVE)... "_$P(X,U,2)
QUIT
;
KILL ; --
K ^TMP("VAQTR",$J,"VALUE",FLE,$S(MFLAG="M":.01,1:FLD),SEQ)
K ^TMP("VAQPT",$J,"VALUE",FLE,$S(MFLAG="M":.01,1:FLD),SEQ)
QUIT
;
EXIT ; -- Note: The list processor cleans up its own variables.
; All other variables cleaned up here.
;
K ^TMP("VAQL2",$J),^TMP("VAQIDX",$J)
K ^TMP("VAQPT",$J),^TMP("VAQTR",$J),^TMP("VAQLD",$J)
K VAQFLAG,VAQUPDFL
K DFNTR,DFNPT,FLE,FLD,SEQ,MFLAG,LFLE
Q
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQLED02 3913 printed Sep 23, 2025@20:01:39 Page 2
VAQLED02 ;ALB/JFP - PDX, LOAD/EDIT,SETUP OF DIFFERENCES;01MAR93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
EP ; -- Main entry point for the list processor
+1 ; -- K XQORS,VALMEVL ;(only kill on the first screen in)
+2 ;
+3 ;D CLEAR^VALM1
+4 SET VAQBCK=0
+5 ; -- collects PDX data and MAS data
DO MAIN^VAQLED04
+6 IF '$DATA(^TMP("VAQTR",$JOB))!('$DATA(^TMP("VAQPT",$JOB)))
Begin DoDot:1
+7 WRITE !," Error...No data collected"
+8 SET VAQFLAG=1
DO TRANEX
End DoDot:1
QUIT
+9 DO EN^VALM("VAQ LED DIFFERENCES PDX6")
+10 QUIT
+11 ;
INIT ; -- Builds array of differences between PDX minimal and the local
+1 ; data stored in file 2.
+2 ;
+3 KILL ^TMP("VAQL2",$JOB)
+4 KILL ^TMP("VAQPT",$JOB,"ID"),^TMP("VAQTR",$JOB,"ID"),^TMP("VAQLD",$JOB)
+5 DO EP^VAQLED05
+6 QUIT
+7 ;
HD ; -- Make header line for list processor
+1 DO HD1^VAQEXT02
QUIT
+2 ;
FIELD ; -- Updates local patient file by field or fields selected
+1 SET (VAQFLAG,VAQUPDFL)=0
+2 DO SEL^VALM2
+3 if '$DATA(VALMY)
QUIT
+4 DO CLEAR^VALM1
+5 SET ENTRY=""
KILL ^TMP("VAQLD",$JOB)
+6 FOR
SET ENTRY=$ORDER(VALMY(ENTRY))
if ENTRY=""
QUIT
Begin DoDot:1
+7 SET SDAT=$GET(^TMP("VAQIDX",$JOB,ENTRY))
+8 DO UPDATE
End DoDot:1
+9 IF VAQUPDFL=1
DO WORKLD
+10 ; -- Redisplay
DO EP1^VAQLED05
+11 SET VALMBCK="R"
+12 SET VAQBCK=1
+13 QUIT
+14 ;
UPDATE ; -- Loads fields for update
+1 SET DFNTR=$PIECE(SDAT,U,1)
+2 SET DFNPT=$PIECE(SDAT,U,2)
+3 IF DFNPT=""
WRITE !,"Local patient pointer missing... unable to upload field"
QUIT
+4 SET (FLE,LFLE)=$PIECE(SDAT,U,3)
+5 SET FLD=$PIECE(SDAT,U,4)
+6 SET SEQ=$PIECE(SDAT,U,5)
+7 SET MFLAG=$PIECE(SDAT,U,6)
+8 ; -- only lock top level file
IF LFLE'=2
SET LFLE=2
+9 SET LOCKFLE=$GET(^DIC(LFLE,0,"GL"))
+10 LOCK +(@(LOCKFLE_DFNPT_")")):60
+11 IF ('$TEST)
WRITE !,"Could not edit entry... record locked"
KILL LOCKFLE
QUIT
+12 if MFLAG=""
DO UPDTER1
+13 if MFLAG="M"
DO UPDTEM1
+14 LOCK -(@(LOCKFLE_DFNPT_")"))
KILL LOCKFLE
+15 ; -- data loaded
+16 SET VAQUPDFL=1
+17 IF '($DATA(Y)#2)
DO KILL
QUIT
+18 ; -- data not pass input transform
SET ^TMP("VAQLD",$JOB,ENTRY)=FLE_"^"_FLD
+19 QUIT
+20 ;
UPDTER1 ; -- Updates patient with PDX data (field by field) ** NON MUTIPLE **
+1 SET DIE=$GET(^DIC(FLE,0,"GL"))
+2 SET DA=DFNPT
+3 SET DR=FLD_"///^S X=$G(^TMP(""VAQTR"",$J,""VALUE"",FLE,FLD,0))"
+4 DO ^DIE
+5 KILL DIE,DA,DR
+6 QUIT
+7 ;
UPDTEM1 ; -- Updates patient with PDX data (field by field) ** MULTIPLE **
+1 ; Loads pointer to main file
+2 ; -- main file
SET MFLE=$GET(^DD(FLE,0,"UP"))
+3 SET MFLD=""
SET MFLD=$ORDER(^DD(MFLE,"SB",FLE,MFLD))
+4 SET FLD=.01
+5 SET DIE=$GET(^DIC(MFLE,0,"GL"))
+6 SET DA=DFNPT
+7 SET DR=MFLD_"///"_$GET(^TMP("VAQTR",$JOB,"VALUE",FLE,FLD,SEQ))
+8 DO UPDTEM2
+9 DO ^DIE
+10 KILL DIE,DA,DR,MFLE,MFLD,VALUE
+11 QUIT
+12 ;
UPDTEM2 ; -- Load fields into sub file for entry
+1 FOR
SET FLD=$ORDER(^TMP("VAQTR",$JOB,"VALUE",FLE,FLD))
if FLD=""
QUIT
Begin DoDot:1
+2 SET VALUE=FLD_"///"_$GET(^TMP("VAQTR",$JOB,"VALUE",FLE,FLD,SEQ))
+3 SET DR(2,FLE)=VALUE
+4 SET DR(2,FLE,FLD)=VALUE
End DoDot:1
+5 QUIT
+6 ;
LOAD ; -- Loads all different fields from PDX segment to local patient file
+1 IF '$DATA(^TMP("VAQIDX",$JOB))
SET VALMBCK="Q"
QUIT
+2 SET (VAQFLAG,VAQUPDFL)=0
+3 DO CLEAR^VALM1
+4 SET ENTRY=""
KILL ^TMP("VAQLD",$JOB)
+5 FOR
SET ENTRY=$ORDER(^TMP("VAQIDX",$JOB,ENTRY))
if ENTRY=""
QUIT
Begin DoDot:1
+6 SET SDAT=$GET(^TMP("VAQIDX",$JOB,ENTRY))
+7 DO UPDATE
End DoDot:1
+8 IF VAQUPDFL=1
DO WORKLD
+9 DO EP1^VAQLED05
+10 SET VALMBCK="R"
+11 SET VAQBCK=1
+12 QUIT
+13 ;
TRANEX ; -- Pauses screen
+1 DO PAUSE^VALM1
+2 if '$DATA(VAQFLAG)
SET VAQFLAG=""
+3 SET VALMBCK=$SELECT(VAQFLAG=0:"R",1:"Q")
+4 QUIT
+5 ;
WORKLD ; -- Updates workload file for update
+1 SET X=$$WORKDONE^VAQADS01("UPDTE",DFNTR,$GET(DUZ))
+2 IF X<0
WRITE !,"Error updating workload file (UPDTE)... "_$PIECE(X,U,2)
+3 IF $PIECE($GET(^VAT(394.61,DFNTR,0)),U,4)=0
QUIT
+4 SET X=$$WORKDONE^VAQADS01("SNSTVE",DFNTR,$GET(DUZ))
+5 IF X<0
WRITE !,"Error updating workload file (SNSTVE)... "_$PIECE(X,U,2)
+6 QUIT
+7 ;
KILL ; --
+1 KILL ^TMP("VAQTR",$JOB,"VALUE",FLE,$SELECT(MFLAG="M":.01,1:FLD),SEQ)
+2 KILL ^TMP("VAQPT",$JOB,"VALUE",FLE,$SELECT(MFLAG="M":.01,1:FLD),SEQ)
+3 QUIT
+4 ;
EXIT ; -- Note: The list processor cleans up its own variables.
+1 ; All other variables cleaned up here.
+2 ;
+3 KILL ^TMP("VAQL2",$JOB),^TMP("VAQIDX",$JOB)
+4 KILL ^TMP("VAQPT",$JOB),^TMP("VAQTR",$JOB),^TMP("VAQLD",$JOB)
+5 KILL VAQFLAG,VAQUPDFL
+6 KILL DFNTR,DFNPT,FLE,FLD,SEQ,MFLAG,LFLE
+7 QUIT
+8 ;
END ; -- End of code
+1 QUIT
