- VAQ2A ;ALB/CMM,JRP - PDX PATCH 15 FIELD VERIFIER ;01-FEB-95
- ;;1.5;PATIENT DATA EXCHANGE;**15**;NOV 17, 1993
- ;
- FIX1 ;Verify triggered field/cross reference in VAQ - RELEASE GROUP file
- ;Kill "C" cross reference
- K ^VAT(394.82,"C")
- ;Declare variables
- N LOOP,LOC,COUNT,DIE,DA,DR,DIC,X,Y
- W !,?3,"Performing update of triggered values in VAQ - RELEASE GROUP file "
- ;Loop through all entries in 394.82 to re-stuff Remote Domain.
- ;Will update any entries that had external format and make it
- ;the pointer value.
- W "."
- S (LOOP,COUNT)=0,DIE="^VAT(394.82,"
- F S LOOP=+$O(^VAT(394.82,LOOP)) Q:('LOOP) D
- .S LOC=$P(^VAT(394.82,LOOP,0),"^",2)
- .S DA=LOOP,DR=".02///"_LOC
- .D ^DIE
- .S COUNT=COUNT+1
- .I '(COUNT#10) W "."
- Q
- FIX2 ;Verify triggered field/cross reference in VAQ - OUTGOING GROUP file
- ;Declare variables
- N ENT,LOOP,COUNT,LOC,DIE,DA,DR,DIC,X,Y
- W !,?3,"Performing update of triggered values in VAQ - OUTGOING GROUP file "
- ;Loop through all entries in 394.83 to re-stuff Remote Domain.
- ;Will update any entries that had external format and make
- ;it the pointer value.
- S (ENT,COUNT)=0
- W "."
- F S ENT=+$O(^VAT(394.83,ENT)) Q:('ENT) D
- .;Kill "A-OUTGRP" cross reference
- .K ^VAT(394.83,ENT,"FAC","A-OUTGRP")
- .S LOOP=0
- .F S LOOP=+$O(^VAT(394.83,ENT,"FAC",LOOP)) Q:('LOOP) D
- ..S LOC=$P(^VAT(394.83,ENT,"FAC",LOOP,0),"^",2)
- ..S DA(1)=ENT,DA=LOOP,DR=".02///"_LOC,DIE="^VAT(394.83,"_ENT_",""FAC"","
- ..D ^DIE
- ..S COUNT=COUNT+1
- ..I '(COUNT#10) W "."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQ2A 1511 printed Feb 18, 2025@23:50:20 Page 2
- VAQ2A ;ALB/CMM,JRP - PDX PATCH 15 FIELD VERIFIER ;01-FEB-95
- +1 ;;1.5;PATIENT DATA EXCHANGE;**15**;NOV 17, 1993
- +2 ;
- FIX1 ;Verify triggered field/cross reference in VAQ - RELEASE GROUP file
- +1 ;Kill "C" cross reference
- +2 KILL ^VAT(394.82,"C")
- +3 ;Declare variables
- +4 NEW LOOP,LOC,COUNT,DIE,DA,DR,DIC,X,Y
- +5 WRITE !,?3,"Performing update of triggered values in VAQ - RELEASE GROUP file "
- +6 ;Loop through all entries in 394.82 to re-stuff Remote Domain.
- +7 ;Will update any entries that had external format and make it
- +8 ;the pointer value.
- +9 WRITE "."
- +10 SET (LOOP,COUNT)=0
- SET DIE="^VAT(394.82,"
- +11 FOR
- SET LOOP=+$ORDER(^VAT(394.82,LOOP))
- if ('LOOP)
- QUIT
- Begin DoDot:1
- +12 SET LOC=$PIECE(^VAT(394.82,LOOP,0),"^",2)
- +13 SET DA=LOOP
- SET DR=".02///"_LOC
- +14 DO ^DIE
- +15 SET COUNT=COUNT+1
- +16 IF '(COUNT#10)
- WRITE "."
- End DoDot:1
- +17 QUIT
- FIX2 ;Verify triggered field/cross reference in VAQ - OUTGOING GROUP file
- +1 ;Declare variables
- +2 NEW ENT,LOOP,COUNT,LOC,DIE,DA,DR,DIC,X,Y
- +3 WRITE !,?3,"Performing update of triggered values in VAQ - OUTGOING GROUP file "
- +4 ;Loop through all entries in 394.83 to re-stuff Remote Domain.
- +5 ;Will update any entries that had external format and make
- +6 ;it the pointer value.
- +7 SET (ENT,COUNT)=0
- +8 WRITE "."
- +9 FOR
- SET ENT=+$ORDER(^VAT(394.83,ENT))
- if ('ENT)
- QUIT
- Begin DoDot:1
- +10 ;Kill "A-OUTGRP" cross reference
- +11 KILL ^VAT(394.83,ENT,"FAC","A-OUTGRP")
- +12 SET LOOP=0
- +13 FOR
- SET LOOP=+$ORDER(^VAT(394.83,ENT,"FAC",LOOP))
- if ('LOOP)
- QUIT
- Begin DoDot:2
- +14 SET LOC=$PIECE(^VAT(394.83,ENT,"FAC",LOOP,0),"^",2)
- +15 SET DA(1)=ENT
- SET DA=LOOP
- SET DR=".02///"_LOC
- SET DIE="^VAT(394.83,"_ENT_",""FAC"","
- +16 DO ^DIE
- +17 SET COUNT=COUNT+1
- +18 IF '(COUNT#10)
- WRITE "."
- End DoDot:2
- End DoDot:1
- +19 QUIT