source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORRHCR.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 5.9 KB
Line 
1ORRHCR ; SLC/KCM/JLI - Hepatitis C Reporting Tools; [4/4/02 2:07pm]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**153**;Dec 17, 1997
3 ;
4NXT() ; Increment ILST
5 S ILST=ILST+1
6 Q ILST
7 ;
8TAG(NAM,VAL) ; Set Name=Value (was <XMLTag>Value</XMLTag>)
9 Q NAM_"="_VAL
10 ;
11GENRPT(LST) ; Retrun a list of Generic reports
12 ; LST(n)="IEN^DisplayText"
13 N NM,ORIG,IEN,ILST S ILST=0
14 ; loop thru the reports for all users
15 S NM="RPT ",ORIG=NM
16 F S NM=$O(^ORD(102.21,"B",NM)) Q:$E(NM,1,4)'=ORIG D RPTLST1
17 Q
18RPTLST(LST) ; Return a list of reports for a user
19 ; LST(n)="IEN^DisplayText"
20 N NM,ORIG,IEN,ILST S ILST=0
21 ; loop thru the reports for all users
22 S NM="RPT ",ORIG=NM
23 F S NM=$O(^ORD(102.21,"B",NM)) Q:$E(NM,1,4)'=ORIG D RPTLST1
24 S LST($$NXT)="0^ "
25 ; loop thru the user's reports
26 Q:'DUZ
27 S NM="RPTU"_DUZ_" ",ORIG=NM
28 F S NM=$O(^ORD(102.21,"B",NM)) Q:$E(NM,1,$L(ORIG))'=ORIG D RPTLST1
29 Q
30RPTLST1 S IEN=0 F S IEN=$O(^ORD(102.21,"B",NM,IEN)) Q:'IEN D
31 . Q:$P(^ORD(102.21,IEN,0),U,4)'="R"
32 . Q:$L($P(^ORD(102.21,IEN,0),U,3))
33 . S LST($$NXT)=IEN_U_$P(^ORD(102.21,IEN,0),U,2)
34 Q
35TAGDEF(LST,TAG) ; Return a critieron definition given a tag
36 N RPTID
37 S RPTID=$O(^ORD(102.21,"T",TAG,0)) Q:'RPTID
38 G RPTDEF1
39RPTDEF(LST,RPTID) ; Return a report definition for a given report
40 ; LST(n)="Name=Value"
41RPTDEF1 I RPTID=0 S RPTID=$O(^ORD(102.21,"B","RPT BASELINE STUB",0))
42 N SEQ,IEN,X0,X1,X4,I,CID,CAP,CNM,EID,ILST,TYP,PAR S ILST=0
43 S X0=^ORD(102.21,RPTID,0),TYP=$P(X0,U,4)
44 S LST($$NXT)=$$TAG("Name",$P(X0,U))
45 S LST($$NXT)=$$TAG("DisplayText",$P(X0,U,2))
46 S SEQ=0 F S SEQ=$O(^ORD(102.21,RPTID,1,"B",SEQ)) Q:'SEQ D
47 . S IEN=0 F S IEN=$O(^ORD(102.21,RPTID,1,"B",SEQ,IEN)) Q:'IEN D
48 . . S X0=^ORD(102.21,RPTID,1,IEN,0)
49 . . S CID=$P(X0,U,2),CNM=$P(X0,U,3),CAP=$P(X0,U,4),EID=""
50 . . I 'CID,TYP="C" S CID=RPTID
51 . . I CID S CID=$P(^ORD(102.21,CID,0),U,7)
52 . . I CNM S X=^ORD(102.22,CNM,0),CNM=$P(X,U),EID=$P(X,U,2)
53 . . S LST($$NXT)=$$TAG("QueryText",SEQ)
54 . . I CID S LST($$NXT)=$$TAG("CriterionTag",CID)
55 . . S LST($$NXT)=$$TAG("Caption",CAP)
56 . . I $L(CNM) S LST($$NXT)=$$TAG("ConstraintName",CNM)
57 . . I EID S LST($$NXT)=$$TAG("EditorID",EID)
58 . . S I=0 F S I=$O(^ORD(102.21,RPTID,1,IEN,1,I)) Q:'I D
59 . . . S LST($$NXT)=$$TAG("Value",^ORD(102.21,RPTID,1,IEN,1,I,0))
60 S SEQ="" F S SEQ=$O(^ORD(102.21,RPTID,2,"B",SEQ)) Q:SEQ="" D
61 . S IEN=0 F S IEN=$O(^ORD(102.21,RPTID,2,"B",SEQ,IEN)) Q:'IEN D
62 . . S X1=^ORD(102.21,RPTID,2,IEN,0)
63 . . S X4=^ORD(102.24,$P(X1,U,2),0)
64 . . S LST($$NXT)=$$TAG("ColumnName",$P(X4,U,1))
65 . . S LST($$NXT)=$$TAG("ColumnHeader",$P(X4,U,3))
66 . . S LST($$NXT)=$$TAG("ColumnWidth",$P(X1,U,3))
67 Q
68CTPLST(LST) ; Return a list of all criteria and parents
69 ; LST(n)=CriteriaTag=ParentTag
70 N NM,ORIG,IEN,X0,PAR,TAG,PTAG,ILST
71 S NM="CT",ORIG=NM,ILST=0
72 F S NM=$O(^ORD(102.21,"B",NM)) Q:$E(NM,1,2)'=ORIG D
73 . S IEN=0 F S IEN=$O(^ORD(102.21,"B",NM,IEN)) Q:'IEN D
74 . . S X0=^ORD(102.21,IEN,0),PAR=+$P(X0,U,6),TAG=+$P(X0,U,7),PTAG=0
75 . . I PAR S PTAG=+$P($G(^ORD(102.21,PAR,0)),U,7)
76 . . S LST($$NXT)=PTAG_"="_TAG
77 Q
78USRRPT(IEN,DTX) ; Return the IEN of a user report given report name
79 N RNM
80 Q:$E(DTX,1,4)'="RPTU"
81 S RNM=$$UP^XLFSTR(DTX)
82 S IEN=+$O(^ORD(102.21,"B",RNM,0))
83 Q
84SAVDEF(RIEN,DEF) ; Save a report definition
85 N I,SEQ,NAM,VAL,RPTDEF,DTX,RNM,QIEN,VIEN,FIEN,CTN,CNM,CAP,WID
86 N RPTID,RPTNM,OLDDTX
87 S RPTID=0,(RPTNM,OLDDTX)=""
88 S SEQ=0
89 S I=0 F S I=$O(DEF(I)) Q:'I D
90 . S NAM=$P(DEF(I),"="),VAL=$P(DEF(I),"=",2) Q:'$L(NAM)
91 . I $E(NAM,1,6)="Column" D Q ;columns in separate subscript
92 . . I NAM="Column" S SEQ=VAL
93 . . I NAM'="Column" S RPTDEF("COL",SEQ,NAM)=VAL
94 . I NAM="QueryText" S SEQ=VAL
95 . I NAM'="Value" S RPTDEF(SEQ,NAM)=VAL
96 . I NAM="Value" S RPTDEF(SEQ,NAM,I)=VAL
97 S:$G(RPTDEF(0,"IEN")) RPTID=RPTDEF(0,"IEN")
98 S RPTNM=$G(RPTDEF(0,"Name"))
99 S DTX=$G(RPTDEF(0,"DisplayText"))
100 I '$L(DTX) S RIEN="0^Name of report not found" Q
101 I RPTID,($E(RPTNM,1,4)'="RPT ") S RIEN=RPTID
102 S RNM="RPTU"_DUZ_" "_$$UP^XLFSTR(DTX)
103 S:'+$G(RIEN) RIEN=$O(^ORD(102.21,"C",RNM,0))
104 I RIEN D Q:'RIEN
105 . N DIK,DA
106 . S DIK="^ORD(102.21,",DA=RIEN D ^DIK
107 . I 'DA S RIEN="0^Error deleting existing report"
108 S RIEN=$$NEWRPT(RNM,DTX)
109 I 'RIEN S RIEN="0^Error adding new report" Q
110 S SEQ=0 F S SEQ=$O(RPTDEF(SEQ)) Q:'SEQ D
111 . S CTN=$G(RPTDEF(SEQ,"CriterionTag"))
112 . I CTN S CTN=$O(^ORD(102.21,"T",CTN,0))
113 . S CNM=$G(RPTDEF(SEQ,"ConstraintName"))
114 . I $L(CNM) S CNM=$O(^ORD(102.22,"B",CNM,0))
115 . S CAP=$G(RPTDEF(SEQ,"Caption"))
116 . S QIEN=$$NEWQTX(RIEN,SEQ,CTN,CNM,CAP)
117 . S I=0 F S I=$O(RPTDEF(SEQ,"Value",I)) Q:I="" D
118 . . S VIEN=$$NEWVAL(RIEN,QIEN,$G(RPTDEF(SEQ,"Value",I)))
119 S SEQ="" F S SEQ=$O(RPTDEF("COL",SEQ)) Q:SEQ="" D
120 . S NAM=$G(RPTDEF("COL",SEQ,"ColumnName"))
121 . S WID=$G(RPTDEF("COL",SEQ,"ColumnWidth"))
122 . S FIEN=$$NEWCOL(RIEN,SEQ,NAM,WID)
123 Q
124NEWRPT(RNM,DTX) ; Add top level criterion
125 N FDA,FDAIEN,DIERR,IENS,ERR
126 S FDA(102.21,"+1,",.01)=RNM
127 S FDA(102.21,"+1,",2)=DTX
128 S FDA(102.21,"+1,",4)="R"
129 S FDA(102.21,"+1,",5)=DUZ
130 D UPDATE^DIE("","FDA","FDAIEN","ERR")
131 Q FDAIEN(1)
132NEWQTX(RIEN,SEQ,CTN,CNM,CAP) ; Add new querytext record for DEF
133 N FDA,FDAIEN,DIERR,IENS,ERR
134 S IENS="+1,"_RIEN_","
135 S FDA(102.211,IENS,.01)=SEQ
136 I $L(CTN) S FDA(102.211,IENS,2)=CTN
137 I $L(CNM) S FDA(102.211,IENS,3)=CNM
138 I $L(CAP) S FDA(102.211,IENS,4)=CAP
139 D UPDATE^DIE("","FDA","FDAIEN","ERR")
140 Q FDAIEN(1)
141NEWVAL(RIEN,QIEN,VAL) ; Add new value record to Query Text
142 N FDA,FDAIEN,DIERR,IENS,ERR
143 S IENS="+1,"_QIEN_","_RIEN_","
144 S FDA(102.2111,IENS,.01)=VAL
145 D UPDATE^DIE("E","FDA","FDAIEN","ERR")
146 Q FDAIEN(1)
147NEWCOL(RIEN,SEQ,NAM,WID) ; Add new format record for DEF
148 N FDA,FDAIEN,DIERR,IENS,ERR
149 S IENS="+1,"_RIEN_","
150 S FDA(102.212,IENS,.01)=SEQ
151 I $L(NAM) S FDA(102.212,IENS,2)=NAM
152 I $L(WID) S FDA(102.212,IENS,3)=WID
153 D UPDATE^DIE("E","FDA","FDAIEN","ERR")
154 Q FDAIEN(1)
155OWNED(VAL,RPT) ; Return 1 is this report is owned by the current user
156 S VAL=0
157 I $P($G(^ORD(102.21,RPT,0)),U,5)=DUZ S VAL=1
158 Q
159DELETE(OK,DA) ; Delete a report
160 N DIK
161 S DIK="^ORD(102.21,"
162 D ^DIK
163 Q
Note: See TracBrowser for help on using the repository browser.