VAQLED05 ;ALB/JFP,JRP - PDX, LOAD/EDIT DIFFERENCES,SCREEN;01MAR93
;;1.5;PATIENT DATA EXCHANGE;**6**;NOV 17, 1993
EP ; -- Main entry point
W !,"Please wait while differences are found..."
EP1 D FLECHK^VAQUTL98,FLDCHK^VAQUTL98 ; -- Build table of excluded fields
S (VAQECNT,VALMCNT)=0
K ^TMP("VAQL2",$J),^TMP("VAQIDX",$J)
I $D(^TMP("VAQLD",$J)) D MSG
D:$D(XRTL) T0^%ZOSV ; -- Capacity start
D MAIN,MULT
I VAQECNT=0 D
.S X=$$SETSTR^VALM1(" ","",1,80) D TMP2
.S X=$$SETSTR^VALM1(" ** No differences found...","",1,80) D TMP2
D EXIT
S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; -- Capacity stop
QUIT
;
MAIN ; -- Loops thru patient file looking for differences by field
S FLE=2,SEQ=0,(TYPE,FLD)=""
F S FLD=$O(^TMP("VAQTR",$J,"VALUE",FLE,FLD)) Q:FLD="" D
.I (FLE=2)&($D(FLD(FLD))) D KILL1 QUIT
.S PDXVALUE=$G(^TMP("VAQTR",$J,"VALUE",FLE,FLD,SEQ))
.I PDXVALUE="" D KILL QUIT
.S PTVALUE=$G(^TMP("VAQPT",$J,"VALUE",FLE,FLD,SEQ))
.I PDXVALUE=PTVALUE D KILL QUIT
.D DISP1,DISP2
QUIT
;
MULT ; -- Loop thru multiple associated with patient file
S FLE=2,FLD=.01,SEQ=0,TYPE="M"
F S FLE=$O(^TMP("VAQTR",$J,"VALUE",FLE)) Q:(FLE="") D M1
QUIT
M1 I $D(FLE(FLE)) D KILL2 QUIT
D MLOAD,MULTDIF
QUIT
;
MLOAD ; -- Loads .01 field of multiple into an array for compare (patient)
K ^TMP("PTVALUE",$J)
S SEQ=""
F S SEQ=$O(^TMP("VAQPT",$J,"VALUE",FLE,FLD,SEQ)) Q:SEQ="" D
.S PTVALUE=$G(^TMP("VAQPT",$J,"VALUE",FLE,FLD,SEQ))
.S:PTVALUE'="" ^TMP("PTVALUE",$J,PTVALUE)=""
QUIT
;
MULTDIF ; -- Displays entries which do not match .01
S SEQ="",FLD=.01
F S SEQ=$O(^TMP("VAQTR",$J,"VALUE",FLE,FLD,SEQ)) Q:SEQ="" D
.S PDXVALUE=$G(^TMP("VAQTR",$J,"VALUE",FLE,FLD,SEQ))
.Q:PDXVALUE=""
.I $D(^TMP("PTVALUE",$J,PDXVALUE)) D KF QUIT
.D DISP1,DISP3,DISP4
S X=$$SETSTR^VALM1(" ","",1,80) D TMP
QUIT
;
DISP1 ; -- Display line 1
S VAQECNT=VAQECNT+1
S X=$$SETSTR^VALM1(VAQECNT,"",1,3)
S FLDNAME="("_$P($G(^DD(FLE,FLD,0)),U,1)_")"
S X=$$SETSTR^VALM1(FLDNAME,X,6,73)
D TMP
QUIT
;
DISP2 ; -- Display line 2
S X=$$SETFLD^VALM1($S(PTVALUE'="":PTVALUE,1:"* no data in patient file "),"","PTVALUE")
S X=$$SETFLD^VALM1($S(PDXVALUE'="":PDXVALUE,1:"* no data in PDX data file "),X,"PDXVALUE")
D TMP
S X=$$SETSTR^VALM1(" ","",1,80) D TMP
QUIT
;
DISP3 ; -- Display line 3
S X=$$SETFLD^VALM1("* multiple does not contain entry ","","PTVALUE")
S X=$$SETFLD^VALM1(PDXVALUE,X,"PDXVALUE")
D TMP
QUIT
;
DISP4 ; -- Displays all fields associated with multiple from transaction file
N FLD
S FLD=.01
F S FLD=$O(^TMP("VAQTR",$J,"VALUE",FLE,FLD)) Q:FLD="" D D41
QUIT
D41 S PDXVALUE=$G(^TMP("VAQTR",$J,"VALUE",FLE,FLD,SEQ))
S FLDNAME=" - ("_$P($G(^DD(FLE,FLD,0)),U,1)_")"
S X=$$SETFLD^VALM1(FLDNAME,"","PTVALUE")
S X=$$SETFLD^VALM1($S(PDXVALUE'="":PDXVALUE,1:"* no data in PDX data file "),X,"PDXVALUE")
D TMP
QUIT
;
KILL ; -- Kills entries which are not different for work arrays
K ^TMP("VAQTR",$J,"VALUE",FLE,FLD,SEQ)
K ^TMP("VAQPT",$J,"VALUE",FLE,FLD,SEQ)
QUIT
KILL1 K ^TMP("VAQTR",$J,"VALUE",FLE,FLD)
K ^TMP("VAQPT",$J,"VALUE",FLE,FLD)
QUIT
KILL2 K ^TMP("VAQTR",$J,"VALUE",FLE)
K ^TMP("VAQPT",$J,"VALUE",FLE)
QUIT
KF ; -- kills fields in subfile
N FLD S FLD=""
F S FLD=$O(^TMP("VAQTR",$J,"VALUE",FLE,FLD)) Q:FLD="" D KILL
QUIT
;
TMP ; -- Set the array used by list processor
S VALMCNT=VALMCNT+1
S ^TMP("VAQL2",$J,VALMCNT,0)=$E(X,1,79)
S ^TMP("VAQL2",$J,"IDX",VALMCNT,VAQECNT)=""
S:SEQ'="" ^TMP("VAQIDX",$J,VAQECNT)=DFNTR_"^"_DFNPT_"^"_FLE_"^"_FLD_"^"_SEQ_"^"_TYPE
Q
MSG ; -- Displays entries not passing the input transform
N ENTRY,NODE,FLDNAME,MSG,LN,X
S X=$$SETSTR^VALM1(" ","",1,79) D TMP2
S ENTRY=""
F S ENTRY=$O(^TMP("VAQLD",$J,ENTRY)) Q:ENTRY="" D
.S NODE=$G(^TMP("VAQLD",$J,ENTRY))
.S FLDNAME=$P($G(^DD($P(NODE,U,1),$P(NODE,U,2),0)),U,1)
.S MSG="* Upload of "_FLDNAME_" did not pass input transform"
.S X=$$SETSTR^VALM1(MSG,"",1,79)
.D TMP2
S X=$$SETSTR^VALM1(" ","",1,79) D TMP2
S LN=$$REPEAT^VAQUTL1("-",79)
S X=$$SETSTR^VALM1(LN,"",1,79) D TMP2
S X=$$SETSTR^VALM1(" ","",1,79) D TMP2
K ENTRY,NODE,FLDNAME,MSG,LN,X
QUIT
;
TMP2 ; -- Sets array for list processor for message
S VALMCNT=VALMCNT+1
S ^TMP("VAQL2",$J,VALMCNT,0)=$E(X,1,79)
S ^TMP("VAQL2",$J,"IDX",VALMCNT,1)=""
QUIT
;
EXIT ; -- Note: The list processor cleans up its own variables.
; All other variables cleaned up here.
K ^TMP("PTVALUE",$J)
K VAQECNT,FLE,FLD,SEQ,TYPE,PDXVALUE,PTVALUE,X,FLDNAME
Q
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQLED05 4616 printed Sep 23, 2025@20:01:41 Page 2
VAQLED05 ;ALB/JFP,JRP - PDX, LOAD/EDIT DIFFERENCES,SCREEN;01MAR93
+1 ;;1.5;PATIENT DATA EXCHANGE;**6**;NOV 17, 1993
EP ; -- Main entry point
+1 WRITE !,"Please wait while differences are found..."
EP1 ; -- Build table of excluded fields
DO FLECHK^VAQUTL98
DO FLDCHK^VAQUTL98
+1 SET (VAQECNT,VALMCNT)=0
+2 KILL ^TMP("VAQL2",$JOB),^TMP("VAQIDX",$JOB)
+3 IF $DATA(^TMP("VAQLD",$JOB))
DO MSG
+4 ; -- Capacity start
if $DATA(XRTL)
DO T0^%ZOSV
+5 DO MAIN
DO MULT
+6 IF VAQECNT=0
Begin DoDot:1
+7 SET X=$$SETSTR^VALM1(" ","",1,80)
DO TMP2
+8 SET X=$$SETSTR^VALM1(" ** No differences found...","",1,80)
DO TMP2
End DoDot:1
+9 DO EXIT
+10 ; -- Capacity stop
if $DATA(XRT0)
SET XRTN=$TEXT(+0)
if $DATA(XRT0)
DO T1^%ZOSV
+11 QUIT
+12 ;
MAIN ; -- Loops thru patient file looking for differences by field
+1 SET FLE=2
SET SEQ=0
SET (TYPE,FLD)=""
+2 FOR
SET FLD=$ORDER(^TMP("VAQTR",$JOB,"VALUE",FLE,FLD))
if FLD=""
QUIT
Begin DoDot:1
+3 IF (FLE=2)&($DATA(FLD(FLD)))
DO KILL1
QUIT
+4 SET PDXVALUE=$GET(^TMP("VAQTR",$JOB,"VALUE",FLE,FLD,SEQ))
+5 IF PDXVALUE=""
DO KILL
QUIT
+6 SET PTVALUE=$GET(^TMP("VAQPT",$JOB,"VALUE",FLE,FLD,SEQ))
+7 IF PDXVALUE=PTVALUE
DO KILL
QUIT
+8 DO DISP1
DO DISP2
End DoDot:1
+9 QUIT
+10 ;
MULT ; -- Loop thru multiple associated with patient file
+1 SET FLE=2
SET FLD=.01
SET SEQ=0
SET TYPE="M"
+2 FOR
SET FLE=$ORDER(^TMP("VAQTR",$JOB,"VALUE",FLE))
if (FLE="")
QUIT
DO M1
+3 QUIT
M1 IF $DATA(FLE(FLE))
DO KILL2
QUIT
+1 DO MLOAD
DO MULTDIF
+2 QUIT
+3 ;
MLOAD ; -- Loads .01 field of multiple into an array for compare (patient)
+1 KILL ^TMP("PTVALUE",$JOB)
+2 SET SEQ=""
+3 FOR
SET SEQ=$ORDER(^TMP("VAQPT",$JOB,"VALUE",FLE,FLD,SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+4 SET PTVALUE=$GET(^TMP("VAQPT",$JOB,"VALUE",FLE,FLD,SEQ))
+5 if PTVALUE'=""
SET ^TMP("PTVALUE",$JOB,PTVALUE)=""
End DoDot:1
+6 QUIT
+7 ;
MULTDIF ; -- Displays entries which do not match .01
+1 SET SEQ=""
SET FLD=.01
+2 FOR
SET SEQ=$ORDER(^TMP("VAQTR",$JOB,"VALUE",FLE,FLD,SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+3 SET PDXVALUE=$GET(^TMP("VAQTR",$JOB,"VALUE",FLE,FLD,SEQ))
+4 if PDXVALUE=""
QUIT
+5 IF $DATA(^TMP("PTVALUE",$JOB,PDXVALUE))
DO KF
QUIT
+6 DO DISP1
DO DISP3
DO DISP4
End DoDot:1
+7 SET X=$$SETSTR^VALM1(" ","",1,80)
DO TMP
+8 QUIT
+9 ;
DISP1 ; -- Display line 1
+1 SET VAQECNT=VAQECNT+1
+2 SET X=$$SETSTR^VALM1(VAQECNT,"",1,3)
+3 SET FLDNAME="("_$PIECE($GET(^DD(FLE,FLD,0)),U,1)_")"
+4 SET X=$$SETSTR^VALM1(FLDNAME,X,6,73)
+5 DO TMP
+6 QUIT
+7 ;
DISP2 ; -- Display line 2
+1 SET X=$$SETFLD^VALM1($SELECT(PTVALUE'="":PTVALUE,1:"* no data in patient file "),"","PTVALUE")
+2 SET X=$$SETFLD^VALM1($SELECT(PDXVALUE'="":PDXVALUE,1:"* no data in PDX data file "),X,"PDXVALUE")
+3 DO TMP
+4 SET X=$$SETSTR^VALM1(" ","",1,80)
DO TMP
+5 QUIT
+6 ;
DISP3 ; -- Display line 3
+1 SET X=$$SETFLD^VALM1("* multiple does not contain entry ","","PTVALUE")
+2 SET X=$$SETFLD^VALM1(PDXVALUE,X,"PDXVALUE")
+3 DO TMP
+4 QUIT
+5 ;
DISP4 ; -- Displays all fields associated with multiple from transaction file
+1 NEW FLD
+2 SET FLD=.01
+3 FOR
SET FLD=$ORDER(^TMP("VAQTR",$JOB,"VALUE",FLE,FLD))
if FLD=""
QUIT
DO D41
+4 QUIT
D41 SET PDXVALUE=$GET(^TMP("VAQTR",$JOB,"VALUE",FLE,FLD,SEQ))
+1 SET FLDNAME=" - ("_$PIECE($GET(^DD(FLE,FLD,0)),U,1)_")"
+2 SET X=$$SETFLD^VALM1(FLDNAME,"","PTVALUE")
+3 SET X=$$SETFLD^VALM1($SELECT(PDXVALUE'="":PDXVALUE,1:"* no data in PDX data file "),X,"PDXVALUE")
+4 DO TMP
+5 QUIT
+6 ;
KILL ; -- Kills entries which are not different for work arrays
+1 KILL ^TMP("VAQTR",$JOB,"VALUE",FLE,FLD,SEQ)
+2 KILL ^TMP("VAQPT",$JOB,"VALUE",FLE,FLD,SEQ)
+3 QUIT
KILL1 KILL ^TMP("VAQTR",$JOB,"VALUE",FLE,FLD)
+1 KILL ^TMP("VAQPT",$JOB,"VALUE",FLE,FLD)
+2 QUIT
KILL2 KILL ^TMP("VAQTR",$JOB,"VALUE",FLE)
+1 KILL ^TMP("VAQPT",$JOB,"VALUE",FLE)
+2 QUIT
KF ; -- kills fields in subfile
+1 NEW FLD
SET FLD=""
+2 FOR
SET FLD=$ORDER(^TMP("VAQTR",$JOB,"VALUE",FLE,FLD))
if FLD=""
QUIT
DO KILL
+3 QUIT
+4 ;
TMP ; -- Set the array used by list processor
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("VAQL2",$JOB,VALMCNT,0)=$EXTRACT(X,1,79)
+3 SET ^TMP("VAQL2",$JOB,"IDX",VALMCNT,VAQECNT)=""
+4 if SEQ'=""
SET ^TMP("VAQIDX",$JOB,VAQECNT)=DFNTR_"^"_DFNPT_"^"_FLE_"^"_FLD_"^"_SEQ_"^"_TYPE
+5 QUIT
MSG ; -- Displays entries not passing the input transform
+1 NEW ENTRY,NODE,FLDNAME,MSG,LN,X
+2 SET X=$$SETSTR^VALM1(" ","",1,79)
DO TMP2
+3 SET ENTRY=""
+4 FOR
SET ENTRY=$ORDER(^TMP("VAQLD",$JOB,ENTRY))
if ENTRY=""
QUIT
Begin DoDot:1
+5 SET NODE=$GET(^TMP("VAQLD",$JOB,ENTRY))
+6 SET FLDNAME=$PIECE($GET(^DD($PIECE(NODE,U,1),$PIECE(NODE,U,2),0)),U,1)
+7 SET MSG="* Upload of "_FLDNAME_" did not pass input transform"
+8 SET X=$$SETSTR^VALM1(MSG,"",1,79)
+9 DO TMP2
End DoDot:1
+10 SET X=$$SETSTR^VALM1(" ","",1,79)
DO TMP2
+11 SET LN=$$REPEAT^VAQUTL1("-",79)
+12 SET X=$$SETSTR^VALM1(LN,"",1,79)
DO TMP2
+13 SET X=$$SETSTR^VALM1(" ","",1,79)
DO TMP2
+14 KILL ENTRY,NODE,FLDNAME,MSG,LN,X
+15 QUIT
+16 ;
TMP2 ; -- Sets array for list processor for message
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("VAQL2",$JOB,VALMCNT,0)=$EXTRACT(X,1,79)
+3 SET ^TMP("VAQL2",$JOB,"IDX",VALMCNT,1)=""
+4 QUIT
+5 ;
EXIT ; -- Note: The list processor cleans up its own variables.
+1 ; All other variables cleaned up here.
+2 KILL ^TMP("PTVALUE",$JOB)
+3 KILL VAQECNT,FLE,FLD,SEQ,TYPE,PDXVALUE,PTVALUE,X,FLDNAME
+4 QUIT
+5 ;
END ; -- End of code
+1 QUIT
