source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DMSQP5.m@ 1071

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1DMSQP5 ;SFISC/EZ-DD LISTING USING SQLI ;10/30/97 17:46
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4EN ; for a single file or number range, display DD information
5 I '$O(^DMSQ("S",0)) W !?5,"Sorry, SQLI files are empty.",! Q
6 I $$WAIT^DMSQT1 D Q
7 . W !?5,"Try later. SQLI is being re-built right now."
8 D DT^DICRW S DMQ="" D ASK G EXIT:DMQ D ASK1 G EXIT:DMQ
9 S %ZIS="Q" D ^%ZIS G EXIT:POP
10 I $D(IO("Q")) D G EXIT
11 . S ZTRTN="DQ^DMSQP5",ZTSAVE("DMFN")="",ZTSAVE("DMFN1")=""
12 . D ^%ZTLOAD
13 D DQ
14EXIT D ^%ZISC
15 K DMFN,DMFN1,DM1,DM2,DMQ
16 Q
17ASK ; select file numbers
18 W !,"WARNING: REPORT JUST WRITES TO THE SCREEN WITHOUT PAGE BREAKS"
19 W !," (INTENDED FOR SCREEN CAPTURES) SO PICK ONE TABLE"
20 W !," OR A SMALL RANGE WHEN TESTING",!
21 S DM1=$O(^DMSQ("T","C",0)),DM2=$O(^DMSQ("T","C",99999999999),-1)
22 S DIR(0)="NO^"_DM1_":"_DM2_":999999999",DIR("A")="Starting File Number"
23 S DIR("?")="Enter the number of the file, e.g. 200 or 1.5215"
24 S DIR("B")=1.521 D ^DIR S:$D(DIRUT) DMQ=1 K DIR Q:DMQ S DMFN=Y
25 I '$D(^DMSQ("T","C",DMFN)) W !,"SQLI table not found." G ASK
26 Q
27ASK1 S DIR("B")=DMFN ; default to one file (not a range)
28 S DIR(0)="NO^"_DM1_":"_DM2_":999999999",DIR("A")=" Ending File Number"
29 S DIR("?")="Optionally enter a larger number for a range, e.g. 1.5217"
30 D ^DIR S:$D(DTOUT)!$D(DUOUT) DMQ=1 K DIR Q:DMQ S DMFN1=Y
31 I '$D(^DMSQ("T","C",DMFN1)) D G ASK1
32 . W !!?5,"There isn't a table for the file number you've entered."
33 . W !?5,"(The highest possible number is "_DM2_".)",!
34 I DMFN1'=DMFN,DMFN1'>DMFN D G ASK1
35 . W !!?5,"Enter a LARGER number to get a range."
36 . W !?5,"The highest possible number here is "_DM2_".",!
37 Q
38DQ ; print DD information in file number order
39 ; find file number links (from subfiles or pointers)
40 U IO
41 N DMQ,FI,TI,EI,CI,PEI,PI,FEI,FKI
42 N GBL,PARLNK,LINK,PTRLNK,FLD,FLDGBL,ID,PIECE,EXTRACT,FN,DMSQTMP,TN,EN
43 S DMQ="",FI=$O(^DMSQ("T","C",DMFN),-1)
44 F S FI=$O(^DMSQ("T","C",FI)) Q:(DMQ)!(FI>DMFN1)!(FI'>0) D
45 . S TI=0 F S TI=$O(^DMSQ("T","C",FI,TI)) Q:(DMQ)!(TI'>0) D
46 .. S TN=$P(^DMSQ("T",TI,0),U,1)
47 .. S (EI,GBL,PARLNK)=""
48 .. F S EI=$O(^DMSQ("E","F",TI,"C",EI)) Q:(DMQ)!(EI'>0) D
49 ... D PAGE I $D(DIRUT) S DMQ=1 Q
50 ... D RPT
51 Q
52PAGE ; do page breaks if using a terminal (C-) device
53 I ($Y+6>IOSL)&(IOST["C-") S DIR(0)="E" D ^DIR K DIR W @IOF
54 Q
55RPT ;
56 I $P(^DMSQ("E",EI,0),U,2)=14 Q ;exclude wp fields here
57 ;include the subfiles created from wp fields later on
58 S EN=$P(^DMSQ("E",EI,0),U,1)
59 S (LINK,PTRLNK,FLD,FLDGBL,ID)=""
60 S CI=$O(^DMSQ("C","B",EI,""))
61 S PEI=$O(^DMSQ("E","F",TI,"P",""))
62 S PI="" F S PI=$O(^DMSQ("P","B",PEI,PI)) Q:PI'>0 D
63 . I CI=$P(^DMSQ("P",PI,0),U,2) D
64 .. S GBL=GBL_^DMSQ("C",CI,1)_"{K}",ID=1
65 S FEI=0 F S FEI=$O(^DMSQ("E","F",TI,"F",FEI)) Q:FEI'>0 D
66 . S FKI=$O(^DMSQ("F","B",FEI,""))
67 . I FKI,CI=$P(^DMSQ("F",FKI,0),U,3) D
68 .. S LINK=$P(^DMSQ("T",$P(^DMSQ("DM",$P(^DMSQ("E",FEI,0),U,2),0),U,4),0),U,7)
69 .. S:ID PARLNK=LINK S:'ID PTRLNK=LINK
70 Q:ID D ;just process non-ID columns (regular fields)
71 . S FLD=$P(^DMSQ("C",CI,0),U,6) I $D(^DMSQ("C",CI,1)) D
72 .. S FLDGBL=GBL_^DMSQ("C",CI,1)
73 .. S PIECE=$P(^DMSQ("C",CI,0),U,11)
74 .. S EXTRACT=$P(^DMSQ("C",CI,0),U,12)_","_$P(^(0),U,13)
75 .. S:PIECE FLDGBL="$P("_FLDGBL_",U,"_PIECE_")"
76 .. S:EXTRACT FLDGBL="$E("_FLDGBL_","_EXTRACT_")"
77 D FIELD^DID(FI,FLD,"","LABEL;TYPE","DMSQTMP")
78 S FN=$S($D(^DIC(FI)):$P(^(FI,0),U),1:$O(^DD(FI,0,"NM","")))
79 W !,FI_" "_FN,!?($L(FI)-3),"TBL:"_TN
80 W !?10,FLD_" "_$G(DMSQTMP("LABEL")),!?($L(FLD)+7),"COL:"_EN
81 W !?20,$G(DMSQTMP("TYPE"))
82 W:PTRLNK ?32,"TO: "_PTRLNK
83 W:PARLNK ?52,"SUBFILE OF: "_PARLNK
84 W !?20,FLDGBL
85 Q
Note: See TracBrowser for help on using the repository browser.