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

VAQ2A.m

Go to the documentation of this file.
  1. VAQ2A ;ALB/CMM,JRP - PDX PATCH 15 FIELD VERIFIER ;01-FEB-95
  1. ;;1.5;PATIENT DATA EXCHANGE;**15**;NOV 17, 1993
  1. ;
  1. FIX1 ;Verify triggered field/cross reference in VAQ - RELEASE GROUP file
  1. ;Kill "C" cross reference
  1. K ^VAT(394.82,"C")
  1. ;Declare variables
  1. N LOOP,LOC,COUNT,DIE,DA,DR,DIC,X,Y
  1. W !,?3,"Performing update of triggered values in VAQ - RELEASE GROUP file "
  1. ;Loop through all entries in 394.82 to re-stuff Remote Domain.
  1. ;Will update any entries that had external format and make it
  1. ;the pointer value.
  1. W "."
  1. S (LOOP,COUNT)=0,DIE="^VAT(394.82,"
  1. F S LOOP=+$O(^VAT(394.82,LOOP)) Q:('LOOP) D
  1. .S LOC=$P(^VAT(394.82,LOOP,0),"^",2)
  1. .S DA=LOOP,DR=".02///"_LOC
  1. .D ^DIE
  1. .S COUNT=COUNT+1
  1. .I '(COUNT#10) W "."
  1. Q
  1. FIX2 ;Verify triggered field/cross reference in VAQ - OUTGOING GROUP file
  1. ;Declare variables
  1. N ENT,LOOP,COUNT,LOC,DIE,DA,DR,DIC,X,Y
  1. W !,?3,"Performing update of triggered values in VAQ - OUTGOING GROUP file "
  1. ;Loop through all entries in 394.83 to re-stuff Remote Domain.
  1. ;Will update any entries that had external format and make
  1. ;it the pointer value.
  1. S (ENT,COUNT)=0
  1. W "."
  1. F S ENT=+$O(^VAT(394.83,ENT)) Q:('ENT) D
  1. .;Kill "A-OUTGRP" cross reference
  1. .K ^VAT(394.83,ENT,"FAC","A-OUTGRP")
  1. .S LOOP=0
  1. .F S LOOP=+$O(^VAT(394.83,ENT,"FAC",LOOP)) Q:('LOOP) D
  1. ..S LOC=$P(^VAT(394.83,ENT,"FAC",LOOP,0),"^",2)
  1. ..S DA(1)=ENT,DA=LOOP,DR=".02///"_LOC,DIE="^VAT(394.83,"_ENT_",""FAC"","
  1. ..D ^DIE
  1. ..S COUNT=COUNT+1
  1. ..I '(COUNT#10) W "."
  1. Q