Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORRHCR

ORRHCR.m

Go to the documentation of this file.
  1. ORRHCR ; SLC/KCM/JLI - Hepatitis C Reporting Tools; [4/4/02 2:07pm]
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**153**;Dec 17, 1997
  1. ;
  1. NXT() ; Increment ILST
  1. S ILST=ILST+1
  1. Q ILST
  1. ;
  1. TAG(NAM,VAL) ; Set Name=Value (was <XMLTag>Value</XMLTag>)
  1. Q NAM_"="_VAL
  1. ;
  1. GENRPT(LST) ; Retrun a list of Generic reports
  1. ; LST(n)="IEN^DisplayText"
  1. N NM,ORIG,IEN,ILST S ILST=0
  1. ; loop thru the reports for all users
  1. S NM="RPT ",ORIG=NM
  1. F S NM=$O(^ORD(102.21,"B",NM)) Q:$E(NM,1,4)'=ORIG D RPTLST1
  1. Q
  1. RPTLST(LST) ; Return a list of reports for a user
  1. ; LST(n)="IEN^DisplayText"
  1. N NM,ORIG,IEN,ILST S ILST=0
  1. ; loop thru the reports for all users
  1. S NM="RPT ",ORIG=NM
  1. F S NM=$O(^ORD(102.21,"B",NM)) Q:$E(NM,1,4)'=ORIG D RPTLST1
  1. S LST($$NXT)="0^ "
  1. ; loop thru the user's reports
  1. Q:'DUZ
  1. S NM="RPTU"_DUZ_" ",ORIG=NM
  1. F S NM=$O(^ORD(102.21,"B",NM)) Q:$E(NM,1,$L(ORIG))'=ORIG D RPTLST1
  1. Q
  1. RPTLST1 S IEN=0 F S IEN=$O(^ORD(102.21,"B",NM,IEN)) Q:'IEN D
  1. . Q:$P(^ORD(102.21,IEN,0),U,4)'="R"
  1. . Q:$L($P(^ORD(102.21,IEN,0),U,3))
  1. . S LST($$NXT)=IEN_U_$P(^ORD(102.21,IEN,0),U,2)
  1. Q
  1. TAGDEF(LST,TAG) ; Return a critieron definition given a tag
  1. N RPTID
  1. S RPTID=$O(^ORD(102.21,"T",TAG,0)) Q:'RPTID
  1. G RPTDEF1
  1. RPTDEF(LST,RPTID) ; Return a report definition for a given report
  1. ; LST(n)="Name=Value"
  1. RPTDEF1 I RPTID=0 S RPTID=$O(^ORD(102.21,"B","RPT BASELINE STUB",0))
  1. N SEQ,IEN,X0,X1,X4,I,CID,CAP,CNM,EID,ILST,TYP,PAR S ILST=0
  1. S X0=^ORD(102.21,RPTID,0),TYP=$P(X0,U,4)
  1. S LST($$NXT)=$$TAG("Name",$P(X0,U))
  1. S LST($$NXT)=$$TAG("DisplayText",$P(X0,U,2))
  1. S SEQ=0 F S SEQ=$O(^ORD(102.21,RPTID,1,"B",SEQ)) Q:'SEQ D
  1. . S IEN=0 F S IEN=$O(^ORD(102.21,RPTID,1,"B",SEQ,IEN)) Q:'IEN D
  1. . . S X0=^ORD(102.21,RPTID,1,IEN,0)
  1. . . S CID=$P(X0,U,2),CNM=$P(X0,U,3),CAP=$P(X0,U,4),EID=""
  1. . . I 'CID,TYP="C" S CID=RPTID
  1. . . I CID S CID=$P(^ORD(102.21,CID,0),U,7)
  1. . . I CNM S X=^ORD(102.22,CNM,0),CNM=$P(X,U),EID=$P(X,U,2)
  1. . . S LST($$NXT)=$$TAG("QueryText",SEQ)
  1. . . I CID S LST($$NXT)=$$TAG("CriterionTag",CID)
  1. . . S LST($$NXT)=$$TAG("Caption",CAP)
  1. . . I $L(CNM) S LST($$NXT)=$$TAG("ConstraintName",CNM)
  1. . . I EID S LST($$NXT)=$$TAG("EditorID",EID)
  1. . . S I=0 F S I=$O(^ORD(102.21,RPTID,1,IEN,1,I)) Q:'I D
  1. . . . S LST($$NXT)=$$TAG("Value",^ORD(102.21,RPTID,1,IEN,1,I,0))
  1. S SEQ="" F S SEQ=$O(^ORD(102.21,RPTID,2,"B",SEQ)) Q:SEQ="" D
  1. . S IEN=0 F S IEN=$O(^ORD(102.21,RPTID,2,"B",SEQ,IEN)) Q:'IEN D
  1. . . S X1=^ORD(102.21,RPTID,2,IEN,0)
  1. . . S X4=^ORD(102.24,$P(X1,U,2),0)
  1. . . S LST($$NXT)=$$TAG("ColumnName",$P(X4,U,1))
  1. . . S LST($$NXT)=$$TAG("ColumnHeader",$P(X4,U,3))
  1. . . S LST($$NXT)=$$TAG("ColumnWidth",$P(X1,U,3))
  1. Q
  1. CTPLST(LST) ; Return a list of all criteria and parents
  1. ; LST(n)=CriteriaTag=ParentTag
  1. N NM,ORIG,IEN,X0,PAR,TAG,PTAG,ILST
  1. S NM="CT",ORIG=NM,ILST=0
  1. F S NM=$O(^ORD(102.21,"B",NM)) Q:$E(NM,1,2)'=ORIG D
  1. . S IEN=0 F S IEN=$O(^ORD(102.21,"B",NM,IEN)) Q:'IEN D
  1. . . S X0=^ORD(102.21,IEN,0),PAR=+$P(X0,U,6),TAG=+$P(X0,U,7),PTAG=0
  1. . . I PAR S PTAG=+$P($G(^ORD(102.21,PAR,0)),U,7)
  1. . . S LST($$NXT)=PTAG_"="_TAG
  1. Q
  1. USRRPT(IEN,DTX) ; Return the IEN of a user report given report name
  1. N RNM
  1. Q:$E(DTX,1,4)'="RPTU"
  1. S RNM=$$UP^XLFSTR(DTX)
  1. S IEN=+$O(^ORD(102.21,"B",RNM,0))
  1. Q
  1. SAVDEF(RIEN,DEF) ; Save a report definition
  1. N I,SEQ,NAM,VAL,RPTDEF,DTX,RNM,QIEN,VIEN,FIEN,CTN,CNM,CAP,WID
  1. N RPTID,RPTNM,OLDDTX
  1. S RPTID=0,(RPTNM,OLDDTX)=""
  1. S SEQ=0
  1. S I=0 F S I=$O(DEF(I)) Q:'I D
  1. . S NAM=$P(DEF(I),"="),VAL=$P(DEF(I),"=",2) Q:'$L(NAM)
  1. . I $E(NAM,1,6)="Column" D Q ;columns in separate subscript
  1. . . I NAM="Column" S SEQ=VAL
  1. . . I NAM'="Column" S RPTDEF("COL",SEQ,NAM)=VAL
  1. . I NAM="QueryText" S SEQ=VAL
  1. . I NAM'="Value" S RPTDEF(SEQ,NAM)=VAL
  1. . I NAM="Value" S RPTDEF(SEQ,NAM,I)=VAL
  1. S:$G(RPTDEF(0,"IEN")) RPTID=RPTDEF(0,"IEN")
  1. S RPTNM=$G(RPTDEF(0,"Name"))
  1. S DTX=$G(RPTDEF(0,"DisplayText"))
  1. I '$L(DTX) S RIEN="0^Name of report not found" Q
  1. I RPTID,($E(RPTNM,1,4)'="RPT ") S RIEN=RPTID
  1. S RNM="RPTU"_DUZ_" "_$$UP^XLFSTR(DTX)
  1. S:'+$G(RIEN) RIEN=$O(^ORD(102.21,"C",RNM,0))
  1. I RIEN D Q:'RIEN
  1. . N DIK,DA
  1. . S DIK="^ORD(102.21,",DA=RIEN D ^DIK
  1. . I 'DA S RIEN="0^Error deleting existing report"
  1. S RIEN=$$NEWRPT(RNM,DTX)
  1. I 'RIEN S RIEN="0^Error adding new report" Q
  1. S SEQ=0 F S SEQ=$O(RPTDEF(SEQ)) Q:'SEQ D
  1. . S CTN=$G(RPTDEF(SEQ,"CriterionTag"))
  1. . I CTN S CTN=$O(^ORD(102.21,"T",CTN,0))
  1. . S CNM=$G(RPTDEF(SEQ,"ConstraintName"))
  1. . I $L(CNM) S CNM=$O(^ORD(102.22,"B",CNM,0))
  1. . S CAP=$G(RPTDEF(SEQ,"Caption"))
  1. . S QIEN=$$NEWQTX(RIEN,SEQ,CTN,CNM,CAP)
  1. . S I=0 F S I=$O(RPTDEF(SEQ,"Value",I)) Q:I="" D
  1. . . S VIEN=$$NEWVAL(RIEN,QIEN,$G(RPTDEF(SEQ,"Value",I)))
  1. S SEQ="" F S SEQ=$O(RPTDEF("COL",SEQ)) Q:SEQ="" D
  1. . S NAM=$G(RPTDEF("COL",SEQ,"ColumnName"))
  1. . S WID=$G(RPTDEF("COL",SEQ,"ColumnWidth"))
  1. . S FIEN=$$NEWCOL(RIEN,SEQ,NAM,WID)
  1. Q
  1. NEWRPT(RNM,DTX) ; Add top level criterion
  1. N FDA,FDAIEN,DIERR,IENS,ERR
  1. S FDA(102.21,"+1,",.01)=RNM
  1. S FDA(102.21,"+1,",2)=DTX
  1. S FDA(102.21,"+1,",4)="R"
  1. S FDA(102.21,"+1,",5)=DUZ
  1. D UPDATE^DIE("","FDA","FDAIEN","ERR")
  1. Q FDAIEN(1)
  1. NEWQTX(RIEN,SEQ,CTN,CNM,CAP) ; Add new querytext record for DEF
  1. N FDA,FDAIEN,DIERR,IENS,ERR
  1. S IENS="+1,"_RIEN_","
  1. S FDA(102.211,IENS,.01)=SEQ
  1. I $L(CTN) S FDA(102.211,IENS,2)=CTN
  1. I $L(CNM) S FDA(102.211,IENS,3)=CNM
  1. I $L(CAP) S FDA(102.211,IENS,4)=CAP
  1. D UPDATE^DIE("","FDA","FDAIEN","ERR")
  1. Q FDAIEN(1)
  1. NEWVAL(RIEN,QIEN,VAL) ; Add new value record to Query Text
  1. N FDA,FDAIEN,DIERR,IENS,ERR
  1. S IENS="+1,"_QIEN_","_RIEN_","
  1. S FDA(102.2111,IENS,.01)=VAL
  1. D UPDATE^DIE("E","FDA","FDAIEN","ERR")
  1. Q FDAIEN(1)
  1. NEWCOL(RIEN,SEQ,NAM,WID) ; Add new format record for DEF
  1. N FDA,FDAIEN,DIERR,IENS,ERR
  1. S IENS="+1,"_RIEN_","
  1. S FDA(102.212,IENS,.01)=SEQ
  1. I $L(NAM) S FDA(102.212,IENS,2)=NAM
  1. I $L(WID) S FDA(102.212,IENS,3)=WID
  1. D UPDATE^DIE("E","FDA","FDAIEN","ERR")
  1. Q FDAIEN(1)
  1. OWNED(VAL,RPT) ; Return 1 is this report is owned by the current user
  1. S VAL=0
  1. I $P($G(^ORD(102.21,RPT,0)),U,5)=DUZ S VAL=1
  1. Q
  1. DELETE(OK,DA) ; Delete a report
  1. N DIK
  1. S DIK="^ORD(102.21,"
  1. D ^DIK
  1. Q