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

MCARVCHK.m

Go to the documentation of this file. 
  1. MCARVCHK ;HIRMFO/DAD-MEDICINE VIEW FILE SANITY CHECK ;5/23/96  11:09
  1.  ;;2.3;Medicine;;09/13/1996
  1.  ;
  1.  K %ZIS,IOP S %ZIS="QM" W ! D ^%ZIS G:POP EXIT
  1.  I $D(IO("Q")) D  G EXIT
  1.  . S ZTRTN="TASK^MCARVCHK"
  1.  . S ZTDESC="Medicine View file (#690.2) sanity check report"
  1.  . D ^%ZTLOAD
  1.  . Q
  1. TASK ;
  1.  K ^TMP("MCARVCHK",$J)
  1.  S (MCD0,MCERR)=0
  1.  F  S MCD0=$O(^MCAR(690.2,MCD0)) Q:MCD0'>0  D MAIN
  1. PRINT ;
  1.  U IO K MCUNDL
  1.  S MCEXIT=0,MCPAGE=1,$P(MCUNDL,"-",81)=""
  1.  S MCTODAY=$$FMTE^XLFDT(DT)
  1.  D HEADER
  1.  I $O(^TMP("MCARVCHK",$J,0))'>0 D  G EXIT
  1.  . W !!,"NO PROBLEMS FOUND"
  1.  . Q
  1.  S MCERR=0
  1.  F  S MCERR=$O(^TMP("MCARVCHK",$J,MCERR)) Q:MCERR'>0!MCEXIT  D
  1.  . S MCDATA=^TMP("MCARVCHK",$J,MCERR)
  1.  . S MCNAME=$P(MCDATA,U),MCFILE=$P(MCDATA,U,2),MCTEXT=$P(MCDATA,U,3)
  1.  . W !!,MCNAME,?70,MCFILE,!?5,MCTEXT
  1.  . I $Y>(IOSL-4) D PAUSE,HEADER
  1.  . Q
  1. EXIT ;
  1.  D ^%ZISC
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  K %ZIS,DIR,DIROUT,DIRUT,DTOUT,DUOUT,MCD0,MCD1,MCD2,MCDATA,MCERR,MCEXIT
  1.  K MCFIELD,MCFILE,MCFL,MCNAME,MCPAGE,MCSUBFIL,MCSUBFLD,MCTEXT,MCTODAY
  1.  K MCUNDL,MCUP,MCZERO,POP,X,Y,ZTDESC,ZTRTN,^TMP("MCARVCHK",$J)
  1.  Q
  1. MAIN ;
  1.  K ^TMP("MCSUB",$J)
  1.  S MCZERO=$G(^MCAR(690.2,MCD0,0))
  1.  S MCNAME=$P(MCZERO,U),MCFILE=+$P(MCZERO,U,2)
  1.  ;
  1.  ; *** Check the Primary File ***
  1.  ;
  1.  I $$VFILE^DILFD(MCFILE)'>0 D  Q
  1.  . D ERR("Primary file # "_MCFILE_" does not exist")
  1.  . Q
  1.  ;
  1.  ; *** Check the Field mult ***
  1.  ;
  1.  I $O(^MCAR(690.2,MCD0,1,0))'>0 D
  1.  . D ERR("No Fields specified")
  1.  . Q
  1.  S MCD1=0
  1.  F  S MCD1=$O(^MCAR(690.2,MCD0,1,MCD1)) Q:MCD1'>0  D
  1.  . S MCFIELD=$P($G(^MCAR(690.2,MCD0,1,MCD1,0)),U)
  1.  . I $$VFIELD^DILFD(MCFILE,MCFIELD)'>0 D  Q
  1.  .. D ERR("Field # "_MCFILE_","_MCFIELD_" does not exist")
  1.  .. Q
  1.  . S MCSUBFIL=+$$GET1^DID(MCFILE,MCFIELD,"","SPECIFIER")
  1.  . I MCSUBFIL D
  1.  .. S MC=($O(^DD(MCSUBFIL,.01))'>0)&($D(^DD(MCSUBFIL,.01,0))#2)
  1.  .. S MCTEXT="Field # "_MCFILE_","_MCFIELD_" missing Sub-File/Field"
  1.  .. S MCTEXT=MCTEXT_" # "_MCSUBFIL_","_$S(MC:".01",1:"???")
  1.  .. S ^TMP("MCSUB",$J,MCSUBFIL)=MCTEXT
  1.  .. Q
  1.  . Q
  1.  ;
  1.  ; *** Check the Sub-Field mult ***
  1.  ;
  1.  S MCD1=0
  1.  F  S MCD1=$O(^MCAR(690.2,MCD0,2,MCD1)) Q:MCD1'>0  D
  1.  . S MCSUBFIL=+$P($G(^MCAR(690.2,MCD0,2,MCD1,0)),U)
  1.  . I $G(^DD(MCSUBFIL,0))="" Q
  1.  . I $O(^MCAR(690.2,MCD0,2,MCD1,1,0))'>0 D
  1.  .. D ERR("No Sub-Fields specified for Sub-File # "_MCSUBFIL)
  1.  .. Q
  1.  . S MCD2=0
  1.  . F  S MCD2=$O(^MCAR(690.2,MCD0,2,MCD1,1,MCD2)) Q:MCD2'>0  D
  1.  .. S MCSUBFLD=+$P($G(^MCAR(690.2,MCD0,2,MCD1,1,MCD2,0)),U)
  1.  .. I $$VFIELD^DILFD(MCSUBFIL,MCSUBFLD)'>0 D  Q
  1.  ... D ERR("Sub-Field # "_MCSUBFIL_","_MCSUBFLD_" does not exist")
  1.  ... Q
  1.  .. S MCSUBFIL(0)=+$$GET1^DID(MCSUBFIL,MCSUBFLD,"","SPECIFIER")
  1.  .. I MCSUBFIL(0)>0 D
  1.  ... S MC=($O(^DD(MCSUBFIL(0),.01))'>0)&($D(^DD(MCSUBFIL(0),.01,0))#2)
  1.  ... S MCTEXT="Sub-Field # "_MCSUBFIL_","_MCSUBFLD_" missing Sub-File/"
  1.  ... S MCTEXT=MCTEXT_"Field # "_MCSUBFIL(0)_","_$S(MC:".01",1:"???")
  1.  ... S ^TMP("MCSUB",$J,MCSUBFIL(0))=MCTEXT
  1.  ... Q
  1.  .. Q
  1.  . Q
  1.  ;
  1.  ; *** Check the Sub-File mult ***
  1.  ;
  1.  I $O(^TMP("MCSUB",$J,0)),$O(^MCAR(690.2,MCD0,2,0))'>0 D
  1.  . D ERR("No Sub-Files specified")
  1.  . Q
  1.  S MCD1=0
  1.  F  S MCD1=$O(^MCAR(690.2,MCD0,2,MCD1)) Q:MCD1'>0  D
  1.  . S MCSUBFIL=+$P($G(^MCAR(690.2,MCD0,2,MCD1,0)),U)
  1.  . I $G(^DD(MCSUBFIL,0))="" D  Q
  1.  .. D ERR("Subfile # "_MCSUBFIL_" does not exist")
  1.  .. Q
  1.  . I $D(^TMP("MCSUB",$J,MCSUBFIL)) D
  1.  .. K ^TMP("MCSUB",$J,MCSUBFIL)
  1.  .. Q
  1.  . E  D
  1.  .. S MCUP=+$G(^DD(MCSUBFIL,0,"UP"))
  1.  .. S MCUP=$S(MCUP:MCUP,1:"???")
  1.  .. S MCFL=+$O(^DD(MCUP,"SB",MCSUBFIL,0))
  1.  .. S MCFL=$S(MCFL:MCFL,1:"???")
  1.  .. S MCTEXT="Sub-File # "_MCSUBFIL_" is missing "
  1.  .. S MCTEXT=MCTEXT_$S(MCUP'=MCFILE:"Sub-",1:"")
  1.  .. S MCTEXT=MCTEXT_"File/Field # "_MCUP_","_MCFL
  1.  .. S ^TMP("MCSUB",$J,MCSUBFIL)=MCTEXT
  1.  .. Q
  1.  . Q
  1.  ;
  1.  S MCSUBFIL=0
  1.  F  S MCSUBFIL=$O(^TMP("MCSUB",$J,MCSUBFIL)) Q:MCSUBFIL'>0  D
  1.  . D ERR(^TMP("MCSUB",$J,MCSUBFIL))
  1.  . Q
  1.  K ^TMP("MCSUB",$J)
  1.  Q
  1. ERR(X) ;
  1.  S MCERR=MCERR+1
  1.  S ^TMP("MCARVCHK",$J,MCERR)=MCNAME_U_MCD0_U_X
  1.  Q
  1. PAUSE ;
  1.  I $E(IOST,1,2)="C-" D
  1.  . N DIR S DIR(0)="E" D ^DIR S MCEXIT=$S(Y'>0:1,1:0)
  1.  . Q
  1.  E  D
  1.  . S MCEXIT=0
  1.  . Q
  1.  Q
  1.  I MCEXIT Q
  1.  I ($E(IOST,1,2)="C-")!(MCPAGE>1) W @IOF
  1.  W !?25,"MEDICINE VIEW FILE SANITY CHECK",?68,MCTODAY
  1.  W !?68,"PAGE: ",MCPAGE S MCPAGE=MCPAGE+1
  1.  W !,"PRINT VIEW TEMPLATE NAME",?70,"IEN",!?5,"ERROR MESSAGE"
  1.  W !,MCUNDL
  1.  Q