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

ATSERCHA.m

Go to the documentation of this file.
  1. ATSERCHA ; TUCSON/DG;DISPLAY RESULT OF COMPARISON VALUES [ 10/25/91 3:20 PM ]
  1. ;;2.5;SEARCH TEMPLATE COMPARISON;;OCT 25, 1991
  1. ;
  1. D DISPLAY
  1. D START
  1. D EOJ
  1. Q
  1. ;
  1. DISPLAY ;
  1. W:$D(IOF) @IOF
  1. I $D(IO)#2 U IO ; Use of USE command granted exemption by OMB
  1. E U 0 ; Use of USE command granted exemption by OMB
  1. Q
  1. ;
  1. START ;GET VALUES OUT OF ^UTILITY("ATSEARCH",$J,"MERGED",3
  1. S ATSECMPT=0 F L=0:0 S ATSECMPT=$O(^UTILITY("ATSEARCH",$J,"MERGED",3,ATSECMPT)) Q:ATSECMPT'=+ATSECMPT D @$S(ATSEARCH("FILELINK")=ATSEARCH("PTRFILENUM"):"PTRFILE",1:"NOTPTRFL")
  1. I IO=IO(0) R !!,"Press return when ready to continue ... ",X:DTIME
  1. I IO'=IO(0) X ^%ZIS("C")
  1. Q
  1. ;
  1. PTRFILE ;DISPLAYS .01 FIELD ONLY FROM POINTER FILE IF MERGED RESULTS
  1. ;LINKED TO POINTER FILE
  1. S DR=".01",DA=ATSECMPT,DIC=ATSEARCH("FILELINK") D EN^DIQ1
  1. I $D(^UTILITY("DIQ1",$J,ATSEARCH("FILELINK"),DA,.01)) W !,^(.01)
  1. E W *7,!,"STORED ENTRY, DFN=",DA,", NOT FOUND IN THE ",$P(^DIC(ATSEARCH("FILELINK"),0),U)," FILE"
  1. K ^UTILITY("DIQ1",$J,ATSEARCH("FILELINK"),DA,.01)
  1. Q
  1. ;
  1. NOTPTRFL ;DISPLAYS .01 FIELD AND COMMON FIELD VALUE FROM NOT
  1. ;POINTED TO FILE WITH MERGED RESULTS LINKED TO IT
  1. I ATSEARCH("FILELINK")=ATSEARCH(1,"SRCHFILENUM") S DR=".01;"_ATSEARCH(1,"FIELD")
  1. E S DR=".01;"_ATSEARCH(2,"FIELD")
  1. S DIC=ATSEARCH("FILELINK"),DA=ATSECMPT D EN^DIQ1
  1. I $D(^UTILITY("DIQ1",$J,ATSEARCH("FILELINK"),DA,.01)) W !,^(.01) S ATSEVLU=$S($D(^($P(DR,";",2))):^($P(DR,";",2)),1:"") I ATSEVLU'=^UTILITY("DIQ1",$J,ATSEARCH("FILELINK"),DA,.01) W ?32,$S(ATSEVLU]"":ATSEVLU,1:"POINTER FIELD VALUE IS NULL")
  1. I '$D(^UTILITY("DIQ1",$J,ATSEARCH("FILELINK"),DA,.01)) W *7,!,"STORED ENTRY, DFN=",DA,", NOT FOUND IN THE ",$P(^DIC(ATSEARCH("FILELINK"),0),U)," FILE"
  1. K ^UTILITY("DIQ1",$J,ATSEARCH("FILELINK"),DA)
  1. Q
  1. ;
  1. EOJ ;
  1. K ATSECMPT,ATSEVLU
  1. Q
  1. ;