Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAQLED05

VAQLED05.m

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