source: FOIAVistA/trunk/r/MEDICINE-MC/MCARVCHK.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1MCARVCHK ;HIRMFO/DAD-MEDICINE VIEW FILE SANITY CHECK ;5/23/96 11:09
2 ;;2.3;Medicine;;09/13/1996
3 ;
4 K %ZIS,IOP S %ZIS="QM" W ! D ^%ZIS G:POP EXIT
5 I $D(IO("Q")) D G EXIT
6 . S ZTRTN="TASK^MCARVCHK"
7 . S ZTDESC="Medicine View file (#690.2) sanity check report"
8 . D ^%ZTLOAD
9 . Q
10TASK ;
11 K ^TMP("MCARVCHK",$J)
12 S (MCD0,MCERR)=0
13 F S MCD0=$O(^MCAR(690.2,MCD0)) Q:MCD0'>0 D MAIN
14PRINT ;
15 U IO K MCUNDL
16 S MCEXIT=0,MCPAGE=1,$P(MCUNDL,"-",81)=""
17 S MCTODAY=$$FMTE^XLFDT(DT)
18 D HEADER
19 I $O(^TMP("MCARVCHK",$J,0))'>0 D G EXIT
20 . W !!,"NO PROBLEMS FOUND"
21 . Q
22 S MCERR=0
23 F S MCERR=$O(^TMP("MCARVCHK",$J,MCERR)) Q:MCERR'>0!MCEXIT D
24 . S MCDATA=^TMP("MCARVCHK",$J,MCERR)
25 . S MCNAME=$P(MCDATA,U),MCFILE=$P(MCDATA,U,2),MCTEXT=$P(MCDATA,U,3)
26 . W !!,MCNAME,?70,MCFILE,!?5,MCTEXT
27 . I $Y>(IOSL-4) D PAUSE,HEADER
28 . Q
29EXIT ;
30 D ^%ZISC
31 S:$D(ZTQUEUED) ZTREQ="@"
32 K %ZIS,DIR,DIROUT,DIRUT,DTOUT,DUOUT,MCD0,MCD1,MCD2,MCDATA,MCERR,MCEXIT
33 K MCFIELD,MCFILE,MCFL,MCNAME,MCPAGE,MCSUBFIL,MCSUBFLD,MCTEXT,MCTODAY
34 K MCUNDL,MCUP,MCZERO,POP,X,Y,ZTDESC,ZTRTN,^TMP("MCARVCHK",$J)
35 Q
36MAIN ;
37 K ^TMP("MCSUB",$J)
38 S MCZERO=$G(^MCAR(690.2,MCD0,0))
39 S MCNAME=$P(MCZERO,U),MCFILE=+$P(MCZERO,U,2)
40 ;
41 ; *** Check the Primary File ***
42 ;
43 I $$VFILE^DILFD(MCFILE)'>0 D Q
44 . D ERR("Primary file # "_MCFILE_" does not exist")
45 . Q
46 ;
47 ; *** Check the Field mult ***
48 ;
49 I $O(^MCAR(690.2,MCD0,1,0))'>0 D
50 . D ERR("No Fields specified")
51 . Q
52 S MCD1=0
53 F S MCD1=$O(^MCAR(690.2,MCD0,1,MCD1)) Q:MCD1'>0 D
54 . S MCFIELD=$P($G(^MCAR(690.2,MCD0,1,MCD1,0)),U)
55 . I $$VFIELD^DILFD(MCFILE,MCFIELD)'>0 D Q
56 .. D ERR("Field # "_MCFILE_","_MCFIELD_" does not exist")
57 .. Q
58 . S MCSUBFIL=+$$GET1^DID(MCFILE,MCFIELD,"","SPECIFIER")
59 . I MCSUBFIL D
60 .. S MC=($O(^DD(MCSUBFIL,.01))'>0)&($D(^DD(MCSUBFIL,.01,0))#2)
61 .. S MCTEXT="Field # "_MCFILE_","_MCFIELD_" missing Sub-File/Field"
62 .. S MCTEXT=MCTEXT_" # "_MCSUBFIL_","_$S(MC:".01",1:"???")
63 .. S ^TMP("MCSUB",$J,MCSUBFIL)=MCTEXT
64 .. Q
65 . Q
66 ;
67 ; *** Check the Sub-Field mult ***
68 ;
69 S MCD1=0
70 F S MCD1=$O(^MCAR(690.2,MCD0,2,MCD1)) Q:MCD1'>0 D
71 . S MCSUBFIL=+$P($G(^MCAR(690.2,MCD0,2,MCD1,0)),U)
72 . I $G(^DD(MCSUBFIL,0))="" Q
73 . I $O(^MCAR(690.2,MCD0,2,MCD1,1,0))'>0 D
74 .. D ERR("No Sub-Fields specified for Sub-File # "_MCSUBFIL)
75 .. Q
76 . S MCD2=0
77 . F S MCD2=$O(^MCAR(690.2,MCD0,2,MCD1,1,MCD2)) Q:MCD2'>0 D
78 .. S MCSUBFLD=+$P($G(^MCAR(690.2,MCD0,2,MCD1,1,MCD2,0)),U)
79 .. I $$VFIELD^DILFD(MCSUBFIL,MCSUBFLD)'>0 D Q
80 ... D ERR("Sub-Field # "_MCSUBFIL_","_MCSUBFLD_" does not exist")
81 ... Q
82 .. S MCSUBFIL(0)=+$$GET1^DID(MCSUBFIL,MCSUBFLD,"","SPECIFIER")
83 .. I MCSUBFIL(0)>0 D
84 ... S MC=($O(^DD(MCSUBFIL(0),.01))'>0)&($D(^DD(MCSUBFIL(0),.01,0))#2)
85 ... S MCTEXT="Sub-Field # "_MCSUBFIL_","_MCSUBFLD_" missing Sub-File/"
86 ... S MCTEXT=MCTEXT_"Field # "_MCSUBFIL(0)_","_$S(MC:".01",1:"???")
87 ... S ^TMP("MCSUB",$J,MCSUBFIL(0))=MCTEXT
88 ... Q
89 .. Q
90 . Q
91 ;
92 ; *** Check the Sub-File mult ***
93 ;
94 I $O(^TMP("MCSUB",$J,0)),$O(^MCAR(690.2,MCD0,2,0))'>0 D
95 . D ERR("No Sub-Files specified")
96 . Q
97 S MCD1=0
98 F S MCD1=$O(^MCAR(690.2,MCD0,2,MCD1)) Q:MCD1'>0 D
99 . S MCSUBFIL=+$P($G(^MCAR(690.2,MCD0,2,MCD1,0)),U)
100 . I $G(^DD(MCSUBFIL,0))="" D Q
101 .. D ERR("Subfile # "_MCSUBFIL_" does not exist")
102 .. Q
103 . I $D(^TMP("MCSUB",$J,MCSUBFIL)) D
104 .. K ^TMP("MCSUB",$J,MCSUBFIL)
105 .. Q
106 . E D
107 .. S MCUP=+$G(^DD(MCSUBFIL,0,"UP"))
108 .. S MCUP=$S(MCUP:MCUP,1:"???")
109 .. S MCFL=+$O(^DD(MCUP,"SB",MCSUBFIL,0))
110 .. S MCFL=$S(MCFL:MCFL,1:"???")
111 .. S MCTEXT="Sub-File # "_MCSUBFIL_" is missing "
112 .. S MCTEXT=MCTEXT_$S(MCUP'=MCFILE:"Sub-",1:"")
113 .. S MCTEXT=MCTEXT_"File/Field # "_MCUP_","_MCFL
114 .. S ^TMP("MCSUB",$J,MCSUBFIL)=MCTEXT
115 .. Q
116 . Q
117 ;
118 S MCSUBFIL=0
119 F S MCSUBFIL=$O(^TMP("MCSUB",$J,MCSUBFIL)) Q:MCSUBFIL'>0 D
120 . D ERR(^TMP("MCSUB",$J,MCSUBFIL))
121 . Q
122 K ^TMP("MCSUB",$J)
123 Q
124ERR(X) ;
125 S MCERR=MCERR+1
126 S ^TMP("MCARVCHK",$J,MCERR)=MCNAME_U_MCD0_U_X
127 Q
128PAUSE ;
129 I $E(IOST,1,2)="C-" D
130 . N DIR S DIR(0)="E" D ^DIR S MCEXIT=$S(Y'>0:1,1:0)
131 . Q
132 E D
133 . S MCEXIT=0
134 . Q
135 Q
136HEADER ;
137 I MCEXIT Q
138 I ($E(IOST,1,2)="C-")!(MCPAGE>1) W @IOF
139 W !?25,"MEDICINE VIEW FILE SANITY CHECK",?68,MCTODAY
140 W !?68,"PAGE: ",MCPAGE S MCPAGE=MCPAGE+1
141 W !,"PRINT VIEW TEMPLATE NAME",?70,"IEN",!?5,"ERROR MESSAGE"
142 W !,MCUNDL
143 Q
Note: See TracBrowser for help on using the repository browser.