source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCARVCHK.m@ 1073

MCARVCHK ;HIRMFO/DAD-MEDICINE VIEW FILE SANITY CHECK ;5/23/96  11:09

 ;;2.3;Medicine;;09/13/1996

 ;

 K %ZIS,IOP S %ZIS="QM" W ! D ^%ZIS G:POP EXIT

 I $D(IO("Q")) D  G EXIT

 . S ZTRTN="TASK^MCARVCHK"

 . S ZTDESC="Medicine View file (#690.2) sanity check report"

 . D ^%ZTLOAD

 . Q

TASK ;

 K ^TMP("MCARVCHK",$J)

 S (MCD0,MCERR)=0

 F  S MCD0=$O(^MCAR(690.2,MCD0)) Q:MCD0'>0  D MAIN

PRINT ;

 U IO K MCUNDL

 S MCEXIT=0,MCPAGE=1,$P(MCUNDL,"-",81)=""

 S MCTODAY=$$FMTE^XLFDT(DT)

 D HEADER

 I $O(^TMP("MCARVCHK",$J,0))'>0 D  G EXIT

 . W !!,"NO PROBLEMS FOUND"

 . Q

 S MCERR=0

 F  S MCERR=$O(^TMP("MCARVCHK",$J,MCERR)) Q:MCERR'>0!MCEXIT  D

 . S MCDATA=^TMP("MCARVCHK",$J,MCERR)

 . S MCNAME=$P(MCDATA,U),MCFILE=$P(MCDATA,U,2),MCTEXT=$P(MCDATA,U,3)

 . W !!,MCNAME,?70,MCFILE,!?5,MCTEXT

 . I $Y>(IOSL-4) D PAUSE,HEADER

 . Q

EXIT ;

 D ^%ZISC

 S:$D(ZTQUEUED) ZTREQ="@"

 K %ZIS,DIR,DIROUT,DIRUT,DTOUT,DUOUT,MCD0,MCD1,MCD2,MCDATA,MCERR,MCEXIT

 K MCFIELD,MCFILE,MCFL,MCNAME,MCPAGE,MCSUBFIL,MCSUBFLD,MCTEXT,MCTODAY

 K MCUNDL,MCUP,MCZERO,POP,X,Y,ZTDESC,ZTRTN,^TMP("MCARVCHK",$J)

 Q

MAIN ;

 K ^TMP("MCSUB",$J)

 S MCZERO=$G(^MCAR(690.2,MCD0,0))

 S MCNAME=$P(MCZERO,U),MCFILE=+$P(MCZERO,U,2)

 ;

 ; *** Check the Primary File ***

 ;

 I $$VFILE^DILFD(MCFILE)'>0 D  Q

 . D ERR("Primary file # "_MCFILE_" does not exist")

 . Q

 ;

 ; *** Check the Field mult ***

 ;

 I $O(^MCAR(690.2,MCD0,1,0))'>0 D

 . D ERR("No Fields specified")

 . Q

 S MCD1=0

 F  S MCD1=$O(^MCAR(690.2,MCD0,1,MCD1)) Q:MCD1'>0  D

 . S MCFIELD=$P($G(^MCAR(690.2,MCD0,1,MCD1,0)),U)

 . I $$VFIELD^DILFD(MCFILE,MCFIELD)'>0 D  Q

 .. D ERR("Field # "_MCFILE_","_MCFIELD_" does not exist")

 .. Q

 . S MCSUBFIL=+$$GET1^DID(MCFILE,MCFIELD,"","SPECIFIER")

 . I MCSUBFIL D

 .. S MC=($O(^DD(MCSUBFIL,.01))'>0)&($D(^DD(MCSUBFIL,.01,0))#2)

 .. S MCTEXT="Field # "_MCFILE_","_MCFIELD_" missing Sub-File/Field"

 .. S MCTEXT=MCTEXT_" # "_MCSUBFIL_","_$S(MC:".01",1:"???")

 .. S ^TMP("MCSUB",$J,MCSUBFIL)=MCTEXT

 .. Q

 . Q

 ;

 ; *** Check the Sub-Field mult ***

 ;

 S MCD1=0

 F  S MCD1=$O(^MCAR(690.2,MCD0,2,MCD1)) Q:MCD1'>0  D

 . S MCSUBFIL=+$P($G(^MCAR(690.2,MCD0,2,MCD1,0)),U)

 . I $G(^DD(MCSUBFIL,0))="" Q

 . I $O(^MCAR(690.2,MCD0,2,MCD1,1,0))'>0 D

 .. D ERR("No Sub-Fields specified for Sub-File # "_MCSUBFIL)

 .. Q

 . S MCD2=0

 . F  S MCD2=$O(^MCAR(690.2,MCD0,2,MCD1,1,MCD2)) Q:MCD2'>0  D

 .. S MCSUBFLD=+$P($G(^MCAR(690.2,MCD0,2,MCD1,1,MCD2,0)),U)

 .. I $$VFIELD^DILFD(MCSUBFIL,MCSUBFLD)'>0 D  Q

 ... D ERR("Sub-Field # "_MCSUBFIL_","_MCSUBFLD_" does not exist")

 ... Q

 .. S MCSUBFIL(0)=+$$GET1^DID(MCSUBFIL,MCSUBFLD,"","SPECIFIER")

 .. I MCSUBFIL(0)>0 D

 ... S MC=($O(^DD(MCSUBFIL(0),.01))'>0)&($D(^DD(MCSUBFIL(0),.01,0))#2)

 ... S MCTEXT="Sub-Field # "_MCSUBFIL_","_MCSUBFLD_" missing Sub-File/"

 ... S MCTEXT=MCTEXT_"Field # "_MCSUBFIL(0)_","_$S(MC:".01",1:"???")

 ... S ^TMP("MCSUB",$J,MCSUBFIL(0))=MCTEXT

 ... Q

 .. Q

 . Q

 ;

 ; *** Check the Sub-File mult ***

 ;

 I $O(^TMP("MCSUB",$J,0)),$O(^MCAR(690.2,MCD0,2,0))'>0 D

 . D ERR("No Sub-Files specified")

 . Q

 S MCD1=0

 F  S MCD1=$O(^MCAR(690.2,MCD0,2,MCD1)) Q:MCD1'>0  D

 . S MCSUBFIL=+$P($G(^MCAR(690.2,MCD0,2,MCD1,0)),U)

 . I $G(^DD(MCSUBFIL,0))="" D  Q

 .. D ERR("Subfile # "_MCSUBFIL_" does not exist")

 .. Q

 . I $D(^TMP("MCSUB",$J,MCSUBFIL)) D

 .. K ^TMP("MCSUB",$J,MCSUBFIL)

 .. Q

 . E  D

 .. S MCUP=+$G(^DD(MCSUBFIL,0,"UP"))

 .. S MCUP=$S(MCUP:MCUP,1:"???")

 .. S MCFL=+$O(^DD(MCUP,"SB",MCSUBFIL,0))

 .. S MCFL=$S(MCFL:MCFL,1:"???")

 .. S MCTEXT="Sub-File # "_MCSUBFIL_" is missing "

 .. S MCTEXT=MCTEXT_$S(MCUP'=MCFILE:"Sub-",1:"")

 .. S MCTEXT=MCTEXT_"File/Field # "_MCUP_","_MCFL

 .. S ^TMP("MCSUB",$J,MCSUBFIL)=MCTEXT

 .. Q

 . Q

 ;

 S MCSUBFIL=0

 F  S MCSUBFIL=$O(^TMP("MCSUB",$J,MCSUBFIL)) Q:MCSUBFIL'>0  D

 . D ERR(^TMP("MCSUB",$J,MCSUBFIL))

 . Q

 K ^TMP("MCSUB",$J)

 Q

ERR(X) ;

 S MCERR=MCERR+1

 S ^TMP("MCARVCHK",$J,MCERR)=MCNAME_U_MCD0_U_X

 Q

PAUSE ;

 I $E(IOST,1,2)="C-" D

 . N DIR S DIR(0)="E" D ^DIR S MCEXIT=$S(Y'>0:1,1:0)

 . Q

 E  D

 . S MCEXIT=0

 . Q

 Q

HEADER ;

 I MCEXIT Q

 I ($E(IOST,1,2)="C-")!(MCPAGE>1) W @IOF

 W !?25,"MEDICINE VIEW FILE SANITY CHECK",?68,MCTODAY

 W !?68,"PAGE: ",MCPAGE S MCPAGE=MCPAGE+1

 W !,"PRINT VIEW TEMPLATE NAME",?70,"IEN",!?5,"ERROR MESSAGE"

 W !,MCUNDL

 Q