| 1 | ORRHCR ; SLC/KCM/JLI - Hepatitis C Reporting Tools; [4/4/02 2:07pm]
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**153**;Dec 17, 1997
|
---|
| 3 | ;
|
---|
| 4 | NXT() ; Increment ILST
|
---|
| 5 | S ILST=ILST+1
|
---|
| 6 | Q ILST
|
---|
| 7 | ;
|
---|
| 8 | TAG(NAM,VAL) ; Set Name=Value (was <XMLTag>Value</XMLTag>)
|
---|
| 9 | Q NAM_"="_VAL
|
---|
| 10 | ;
|
---|
| 11 | GENRPT(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
|
---|
| 18 | RPTLST(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
|
---|
| 30 | RPTLST1 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
|
---|
| 35 | TAGDEF(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
|
---|
| 39 | RPTDEF(LST,RPTID) ; Return a report definition for a given report
|
---|
| 40 | ; LST(n)="Name=Value"
|
---|
| 41 | RPTDEF1 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
|
---|
| 68 | CTPLST(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
|
---|
| 78 | USRRPT(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
|
---|
| 84 | SAVDEF(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
|
---|
| 124 | NEWRPT(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)
|
---|
| 132 | NEWQTX(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)
|
---|
| 141 | NEWVAL(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)
|
---|
| 147 | NEWCOL(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)
|
---|
| 155 | OWNED(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
|
---|
| 159 | DELETE(OK,DA) ; Delete a report
|
---|
| 160 | N DIK
|
---|
| 161 | S DIK="^ORD(102.21,"
|
---|
| 162 | D ^DIK
|
---|
| 163 | Q
|
---|