ORRHCR ; SLC/KCM/JLI - Hepatitis C Reporting Tools; [4/4/02 2:07pm]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**153**;Dec 17, 1997
;
NXT() ; Increment ILST
S ILST=ILST+1
Q ILST
;
TAG(NAM,VAL) ; Set Name=Value (was <XMLTag>Value</XMLTag>)
Q NAM_"="_VAL
;
GENRPT(LST) ; Retrun a list of Generic reports
; LST(n)="IEN^DisplayText"
N NM,ORIG,IEN,ILST S ILST=0
; loop thru the reports for all users
S NM="RPT ",ORIG=NM
F S NM=$O(^ORD(102.21,"B",NM)) Q:$E(NM,1,4)'=ORIG D RPTLST1
Q
RPTLST(LST) ; Return a list of reports for a user
; LST(n)="IEN^DisplayText"
N NM,ORIG,IEN,ILST S ILST=0
; loop thru the reports for all users
S NM="RPT ",ORIG=NM
F S NM=$O(^ORD(102.21,"B",NM)) Q:$E(NM,1,4)'=ORIG D RPTLST1
S LST($$NXT)="0^ "
; loop thru the user's reports
Q:'DUZ
S NM="RPTU"_DUZ_" ",ORIG=NM
F S NM=$O(^ORD(102.21,"B",NM)) Q:$E(NM,1,$L(ORIG))'=ORIG D RPTLST1
Q
RPTLST1 S IEN=0 F S IEN=$O(^ORD(102.21,"B",NM,IEN)) Q:'IEN D
. Q:$P(^ORD(102.21,IEN,0),U,4)'="R"
. Q:$L($P(^ORD(102.21,IEN,0),U,3))
. S LST($$NXT)=IEN_U_$P(^ORD(102.21,IEN,0),U,2)
Q
TAGDEF(LST,TAG) ; Return a critieron definition given a tag
N RPTID
S RPTID=$O(^ORD(102.21,"T",TAG,0)) Q:'RPTID
G RPTDEF1
RPTDEF(LST,RPTID) ; Return a report definition for a given report
; LST(n)="Name=Value"
RPTDEF1 I RPTID=0 S RPTID=$O(^ORD(102.21,"B","RPT BASELINE STUB",0))
N SEQ,IEN,X0,X1,X4,I,CID,CAP,CNM,EID,ILST,TYP,PAR S ILST=0
S X0=^ORD(102.21,RPTID,0),TYP=$P(X0,U,4)
S LST($$NXT)=$$TAG("Name",$P(X0,U))
S LST($$NXT)=$$TAG("DisplayText",$P(X0,U,2))
S SEQ=0 F S SEQ=$O(^ORD(102.21,RPTID,1,"B",SEQ)) Q:'SEQ D
. S IEN=0 F S IEN=$O(^ORD(102.21,RPTID,1,"B",SEQ,IEN)) Q:'IEN D
. . S X0=^ORD(102.21,RPTID,1,IEN,0)
. . S CID=$P(X0,U,2),CNM=$P(X0,U,3),CAP=$P(X0,U,4),EID=""
. . I 'CID,TYP="C" S CID=RPTID
. . I CID S CID=$P(^ORD(102.21,CID,0),U,7)
. . I CNM S X=^ORD(102.22,CNM,0),CNM=$P(X,U),EID=$P(X,U,2)
. . S LST($$NXT)=$$TAG("QueryText",SEQ)
. . I CID S LST($$NXT)=$$TAG("CriterionTag",CID)
. . S LST($$NXT)=$$TAG("Caption",CAP)
. . I $L(CNM) S LST($$NXT)=$$TAG("ConstraintName",CNM)
. . I EID S LST($$NXT)=$$TAG("EditorID",EID)
. . S I=0 F S I=$O(^ORD(102.21,RPTID,1,IEN,1,I)) Q:'I D
. . . S LST($$NXT)=$$TAG("Value",^ORD(102.21,RPTID,1,IEN,1,I,0))
S SEQ="" F S SEQ=$O(^ORD(102.21,RPTID,2,"B",SEQ)) Q:SEQ="" D
. S IEN=0 F S IEN=$O(^ORD(102.21,RPTID,2,"B",SEQ,IEN)) Q:'IEN D
. . S X1=^ORD(102.21,RPTID,2,IEN,0)
. . S X4=^ORD(102.24,$P(X1,U,2),0)
. . S LST($$NXT)=$$TAG("ColumnName",$P(X4,U,1))
. . S LST($$NXT)=$$TAG("ColumnHeader",$P(X4,U,3))
. . S LST($$NXT)=$$TAG("ColumnWidth",$P(X1,U,3))
Q
CTPLST(LST) ; Return a list of all criteria and parents
; LST(n)=CriteriaTag=ParentTag
N NM,ORIG,IEN,X0,PAR,TAG,PTAG,ILST
S NM="CT",ORIG=NM,ILST=0
F S NM=$O(^ORD(102.21,"B",NM)) Q:$E(NM,1,2)'=ORIG D
. S IEN=0 F S IEN=$O(^ORD(102.21,"B",NM,IEN)) Q:'IEN D
. . S X0=^ORD(102.21,IEN,0),PAR=+$P(X0,U,6),TAG=+$P(X0,U,7),PTAG=0
. . I PAR S PTAG=+$P($G(^ORD(102.21,PAR,0)),U,7)
. . S LST($$NXT)=PTAG_"="_TAG
Q
USRRPT(IEN,DTX) ; Return the IEN of a user report given report name
N RNM
Q:$E(DTX,1,4)'="RPTU"
S RNM=$$UP^XLFSTR(DTX)
S IEN=+$O(^ORD(102.21,"B",RNM,0))
Q
SAVDEF(RIEN,DEF) ; Save a report definition
N I,SEQ,NAM,VAL,RPTDEF,DTX,RNM,QIEN,VIEN,FIEN,CTN,CNM,CAP,WID
N RPTID,RPTNM,OLDDTX
S RPTID=0,(RPTNM,OLDDTX)=""
S SEQ=0
S I=0 F S I=$O(DEF(I)) Q:'I D
. S NAM=$P(DEF(I),"="),VAL=$P(DEF(I),"=",2) Q:'$L(NAM)
. I $E(NAM,1,6)="Column" D Q ;columns in separate subscript
. . I NAM="Column" S SEQ=VAL
. . I NAM'="Column" S RPTDEF("COL",SEQ,NAM)=VAL
. I NAM="QueryText" S SEQ=VAL
. I NAM'="Value" S RPTDEF(SEQ,NAM)=VAL
. I NAM="Value" S RPTDEF(SEQ,NAM,I)=VAL
S:$G(RPTDEF(0,"IEN")) RPTID=RPTDEF(0,"IEN")
S RPTNM=$G(RPTDEF(0,"Name"))
S DTX=$G(RPTDEF(0,"DisplayText"))
I '$L(DTX) S RIEN="0^Name of report not found" Q
I RPTID,($E(RPTNM,1,4)'="RPT ") S RIEN=RPTID
S RNM="RPTU"_DUZ_" "_$$UP^XLFSTR(DTX)
S:'+$G(RIEN) RIEN=$O(^ORD(102.21,"C",RNM,0))
I RIEN D Q:'RIEN
. N DIK,DA
. S DIK="^ORD(102.21,",DA=RIEN D ^DIK
. I 'DA S RIEN="0^Error deleting existing report"
S RIEN=$$NEWRPT(RNM,DTX)
I 'RIEN S RIEN="0^Error adding new report" Q
S SEQ=0 F S SEQ=$O(RPTDEF(SEQ)) Q:'SEQ D
. S CTN=$G(RPTDEF(SEQ,"CriterionTag"))
. I CTN S CTN=$O(^ORD(102.21,"T",CTN,0))
. S CNM=$G(RPTDEF(SEQ,"ConstraintName"))
. I $L(CNM) S CNM=$O(^ORD(102.22,"B",CNM,0))
. S CAP=$G(RPTDEF(SEQ,"Caption"))
. S QIEN=$$NEWQTX(RIEN,SEQ,CTN,CNM,CAP)
. S I=0 F S I=$O(RPTDEF(SEQ,"Value",I)) Q:I="" D
. . S VIEN=$$NEWVAL(RIEN,QIEN,$G(RPTDEF(SEQ,"Value",I)))
S SEQ="" F S SEQ=$O(RPTDEF("COL",SEQ)) Q:SEQ="" D
. S NAM=$G(RPTDEF("COL",SEQ,"ColumnName"))
. S WID=$G(RPTDEF("COL",SEQ,"ColumnWidth"))
. S FIEN=$$NEWCOL(RIEN,SEQ,NAM,WID)
Q
NEWRPT(RNM,DTX) ; Add top level criterion
N FDA,FDAIEN,DIERR,IENS,ERR
S FDA(102.21,"+1,",.01)=RNM
S FDA(102.21,"+1,",2)=DTX
S FDA(102.21,"+1,",4)="R"
S FDA(102.21,"+1,",5)=DUZ
D UPDATE^DIE("","FDA","FDAIEN","ERR")
Q FDAIEN(1)
NEWQTX(RIEN,SEQ,CTN,CNM,CAP) ; Add new querytext record for DEF
N FDA,FDAIEN,DIERR,IENS,ERR
S IENS="+1,"_RIEN_","
S FDA(102.211,IENS,.01)=SEQ
I $L(CTN) S FDA(102.211,IENS,2)=CTN
I $L(CNM) S FDA(102.211,IENS,3)=CNM
I $L(CAP) S FDA(102.211,IENS,4)=CAP
D UPDATE^DIE("","FDA","FDAIEN","ERR")
Q FDAIEN(1)
NEWVAL(RIEN,QIEN,VAL) ; Add new value record to Query Text
N FDA,FDAIEN,DIERR,IENS,ERR
S IENS="+1,"_QIEN_","_RIEN_","
S FDA(102.2111,IENS,.01)=VAL
D UPDATE^DIE("E","FDA","FDAIEN","ERR")
Q FDAIEN(1)
NEWCOL(RIEN,SEQ,NAM,WID) ; Add new format record for DEF
N FDA,FDAIEN,DIERR,IENS,ERR
S IENS="+1,"_RIEN_","
S FDA(102.212,IENS,.01)=SEQ
I $L(NAM) S FDA(102.212,IENS,2)=NAM
I $L(WID) S FDA(102.212,IENS,3)=WID
D UPDATE^DIE("E","FDA","FDAIEN","ERR")
Q FDAIEN(1)
OWNED(VAL,RPT) ; Return 1 is this report is owned by the current user
S VAL=0
I $P($G(^ORD(102.21,RPT,0)),U,5)=DUZ S VAL=1
Q
DELETE(OK,DA) ; Delete a report
N DIK
S DIK="^ORD(102.21,"
D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORRHCR 6165 printed Sep 23, 2025@20:10:19 Page 2
ORRHCR ; SLC/KCM/JLI - Hepatitis C Reporting Tools; [4/4/02 2:07pm]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**153**;Dec 17, 1997
+2 ;
NXT() ; Increment ILST
+1 SET ILST=ILST+1
+2 QUIT ILST
+3 ;
TAG(NAM,VAL) ; Set Name=Value (was <XMLTag>Value</XMLTag>)
+1 QUIT NAM_"="_VAL
+2 ;
GENRPT(LST) ; Retrun a list of Generic reports
+1 ; LST(n)="IEN^DisplayText"
+2 NEW NM,ORIG,IEN,ILST
SET ILST=0
+3 ; loop thru the reports for all users
+4 SET NM="RPT "
SET ORIG=NM
+5 FOR
SET NM=$ORDER(^ORD(102.21,"B",NM))
if $EXTRACT(NM,1,4)'=ORIG
QUIT
DO RPTLST1
+6 QUIT
RPTLST(LST) ; Return a list of reports for a user
+1 ; LST(n)="IEN^DisplayText"
+2 NEW NM,ORIG,IEN,ILST
SET ILST=0
+3 ; loop thru the reports for all users
+4 SET NM="RPT "
SET ORIG=NM
+5 FOR
SET NM=$ORDER(^ORD(102.21,"B",NM))
if $EXTRACT(NM,1,4)'=ORIG
QUIT
DO RPTLST1
+6 SET LST($$NXT)="0^ "
+7 ; loop thru the user's reports
+8 if 'DUZ
QUIT
+9 SET NM="RPTU"_DUZ_" "
SET ORIG=NM
+10 FOR
SET NM=$ORDER(^ORD(102.21,"B",NM))
if $EXTRACT(NM,1,$LENGTH(ORIG))'=ORIG
QUIT
DO RPTLST1
+11 QUIT
RPTLST1 SET IEN=0
FOR
SET IEN=$ORDER(^ORD(102.21,"B",NM,IEN))
if 'IEN
QUIT
Begin DoDot:1
+1 if $PIECE(^ORD(102.21,IEN,0),U,4)'="R"
QUIT
+2 if $LENGTH($PIECE(^ORD(102.21,IEN,0),U,3))
QUIT
+3 SET LST($$NXT)=IEN_U_$P(^ORD(102.21,IEN,0),U,2)
End DoDot:1
+4 QUIT
TAGDEF(LST,TAG) ; Return a critieron definition given a tag
+1 NEW RPTID
+2 SET RPTID=$ORDER(^ORD(102.21,"T",TAG,0))
if 'RPTID
QUIT
+3 GOTO RPTDEF1
RPTDEF(LST,RPTID) ; Return a report definition for a given report
+1 ; LST(n)="Name=Value"
RPTDEF1 IF RPTID=0
SET RPTID=$ORDER(^ORD(102.21,"B","RPT BASELINE STUB",0))
+1 NEW SEQ,IEN,X0,X1,X4,I,CID,CAP,CNM,EID,ILST,TYP,PAR
SET ILST=0
+2 SET X0=^ORD(102.21,RPTID,0)
SET TYP=$PIECE(X0,U,4)
+3 SET LST($$NXT)=$$TAG("Name",$PIECE(X0,U))
+4 SET LST($$NXT)=$$TAG("DisplayText",$PIECE(X0,U,2))
+5 SET SEQ=0
FOR
SET SEQ=$ORDER(^ORD(102.21,RPTID,1,"B",SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+6 SET IEN=0
FOR
SET IEN=$ORDER(^ORD(102.21,RPTID,1,"B",SEQ,IEN))
if 'IEN
QUIT
Begin DoDot:2
+7 SET X0=^ORD(102.21,RPTID,1,IEN,0)
+8 SET CID=$PIECE(X0,U,2)
SET CNM=$PIECE(X0,U,3)
SET CAP=$PIECE(X0,U,4)
SET EID=""
+9 IF 'CID
IF TYP="C"
SET CID=RPTID
+10 IF CID
SET CID=$PIECE(^ORD(102.21,CID,0),U,7)
+11 IF CNM
SET X=^ORD(102.22,CNM,0)
SET CNM=$PIECE(X,U)
SET EID=$PIECE(X,U,2)
+12 SET LST($$NXT)=$$TAG("QueryText",SEQ)
+13 IF CID
SET LST($$NXT)=$$TAG("CriterionTag",CID)
+14 SET LST($$NXT)=$$TAG("Caption",CAP)
+15 IF $LENGTH(CNM)
SET LST($$NXT)=$$TAG("ConstraintName",CNM)
+16 IF EID
SET LST($$NXT)=$$TAG("EditorID",EID)
+17 SET I=0
FOR
SET I=$ORDER(^ORD(102.21,RPTID,1,IEN,1,I))
if 'I
QUIT
Begin DoDot:3
+18 SET LST($$NXT)=$$TAG("Value",^ORD(102.21,RPTID,1,IEN,1,I,0))
End DoDot:3
End DoDot:2
End DoDot:1
+19 SET SEQ=""
FOR
SET SEQ=$ORDER(^ORD(102.21,RPTID,2,"B",SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+20 SET IEN=0
FOR
SET IEN=$ORDER(^ORD(102.21,RPTID,2,"B",SEQ,IEN))
if 'IEN
QUIT
Begin DoDot:2
+21 SET X1=^ORD(102.21,RPTID,2,IEN,0)
+22 SET X4=^ORD(102.24,$PIECE(X1,U,2),0)
+23 SET LST($$NXT)=$$TAG("ColumnName",$PIECE(X4,U,1))
+24 SET LST($$NXT)=$$TAG("ColumnHeader",$PIECE(X4,U,3))
+25 SET LST($$NXT)=$$TAG("ColumnWidth",$PIECE(X1,U,3))
End DoDot:2
End DoDot:1
+26 QUIT
CTPLST(LST) ; Return a list of all criteria and parents
+1 ; LST(n)=CriteriaTag=ParentTag
+2 NEW NM,ORIG,IEN,X0,PAR,TAG,PTAG,ILST
+3 SET NM="CT"
SET ORIG=NM
SET ILST=0
+4 FOR
SET NM=$ORDER(^ORD(102.21,"B",NM))
if $EXTRACT(NM,1,2)'=ORIG
QUIT
Begin DoDot:1
+5 SET IEN=0
FOR
SET IEN=$ORDER(^ORD(102.21,"B",NM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+6 SET X0=^ORD(102.21,IEN,0)
SET PAR=+$PIECE(X0,U,6)
SET TAG=+$PIECE(X0,U,7)
SET PTAG=0
+7 IF PAR
SET PTAG=+$PIECE($GET(^ORD(102.21,PAR,0)),U,7)
+8 SET LST($$NXT)=PTAG_"="_TAG
End DoDot:2
End DoDot:1
+9 QUIT
USRRPT(IEN,DTX) ; Return the IEN of a user report given report name
+1 NEW RNM
+2 if $EXTRACT(DTX,1,4)'="RPTU"
QUIT
+3 SET RNM=$$UP^XLFSTR(DTX)
+4 SET IEN=+$ORDER(^ORD(102.21,"B",RNM,0))
+5 QUIT
SAVDEF(RIEN,DEF) ; Save a report definition
+1 NEW I,SEQ,NAM,VAL,RPTDEF,DTX,RNM,QIEN,VIEN,FIEN,CTN,CNM,CAP,WID
+2 NEW RPTID,RPTNM,OLDDTX
+3 SET RPTID=0
SET (RPTNM,OLDDTX)=""
+4 SET SEQ=0
+5 SET I=0
FOR
SET I=$ORDER(DEF(I))
if 'I
QUIT
Begin DoDot:1
+6 SET NAM=$PIECE(DEF(I),"=")
SET VAL=$PIECE(DEF(I),"=",2)
if '$LENGTH(NAM)
QUIT
+7 ;columns in separate subscript
IF $EXTRACT(NAM,1,6)="Column"
Begin DoDot:2
+8 IF NAM="Column"
SET SEQ=VAL
+9 IF NAM'="Column"
SET RPTDEF("COL",SEQ,NAM)=VAL
End DoDot:2
QUIT
+10 IF NAM="QueryText"
SET SEQ=VAL
+11 IF NAM'="Value"
SET RPTDEF(SEQ,NAM)=VAL
+12 IF NAM="Value"
SET RPTDEF(SEQ,NAM,I)=VAL
End DoDot:1
+13 if $GET(RPTDEF(0,"IEN"))
SET RPTID=RPTDEF(0,"IEN")
+14 SET RPTNM=$GET(RPTDEF(0,"Name"))
+15 SET DTX=$GET(RPTDEF(0,"DisplayText"))
+16 IF '$LENGTH(DTX)
SET RIEN="0^Name of report not found"
QUIT
+17 IF RPTID
IF ($EXTRACT(RPTNM,1,4)'="RPT ")
SET RIEN=RPTID
+18 SET RNM="RPTU"_DUZ_" "_$$UP^XLFSTR(DTX)
+19 if '+$GET(RIEN)
SET RIEN=$ORDER(^ORD(102.21,"C",RNM,0))
+20 IF RIEN
Begin DoDot:1
+21 NEW DIK,DA
+22 SET DIK="^ORD(102.21,"
SET DA=RIEN
DO ^DIK
+23 IF 'DA
SET RIEN="0^Error deleting existing report"
End DoDot:1
if 'RIEN
QUIT
+24 SET RIEN=$$NEWRPT(RNM,DTX)
+25 IF 'RIEN
SET RIEN="0^Error adding new report"
QUIT
+26 SET SEQ=0
FOR
SET SEQ=$ORDER(RPTDEF(SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+27 SET CTN=$GET(RPTDEF(SEQ,"CriterionTag"))
+28 IF CTN
SET CTN=$ORDER(^ORD(102.21,"T",CTN,0))
+29 SET CNM=$GET(RPTDEF(SEQ,"ConstraintName"))
+30 IF $LENGTH(CNM)
SET CNM=$ORDER(^ORD(102.22,"B",CNM,0))
+31 SET CAP=$GET(RPTDEF(SEQ,"Caption"))
+32 SET QIEN=$$NEWQTX(RIEN,SEQ,CTN,CNM,CAP)
+33 SET I=0
FOR
SET I=$ORDER(RPTDEF(SEQ,"Value",I))
if I=""
QUIT
Begin DoDot:2
+34 SET VIEN=$$NEWVAL(RIEN,QIEN,$GET(RPTDEF(SEQ,"Value",I)))
End DoDot:2
End DoDot:1
+35 SET SEQ=""
FOR
SET SEQ=$ORDER(RPTDEF("COL",SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+36 SET NAM=$GET(RPTDEF("COL",SEQ,"ColumnName"))
+37 SET WID=$GET(RPTDEF("COL",SEQ,"ColumnWidth"))
+38 SET FIEN=$$NEWCOL(RIEN,SEQ,NAM,WID)
End DoDot:1
+39 QUIT
NEWRPT(RNM,DTX) ; Add top level criterion
+1 NEW FDA,FDAIEN,DIERR,IENS,ERR
+2 SET FDA(102.21,"+1,",.01)=RNM
+3 SET FDA(102.21,"+1,",2)=DTX
+4 SET FDA(102.21,"+1,",4)="R"
+5 SET FDA(102.21,"+1,",5)=DUZ
+6 DO UPDATE^DIE("","FDA","FDAIEN","ERR")
+7 QUIT FDAIEN(1)
NEWQTX(RIEN,SEQ,CTN,CNM,CAP) ; Add new querytext record for DEF
+1 NEW FDA,FDAIEN,DIERR,IENS,ERR
+2 SET IENS="+1,"_RIEN_","
+3 SET FDA(102.211,IENS,.01)=SEQ
+4 IF $LENGTH(CTN)
SET FDA(102.211,IENS,2)=CTN
+5 IF $LENGTH(CNM)
SET FDA(102.211,IENS,3)=CNM
+6 IF $LENGTH(CAP)
SET FDA(102.211,IENS,4)=CAP
+7 DO UPDATE^DIE("","FDA","FDAIEN","ERR")
+8 QUIT FDAIEN(1)
NEWVAL(RIEN,QIEN,VAL) ; Add new value record to Query Text
+1 NEW FDA,FDAIEN,DIERR,IENS,ERR
+2 SET IENS="+1,"_QIEN_","_RIEN_","
+3 SET FDA(102.2111,IENS,.01)=VAL
+4 DO UPDATE^DIE("E","FDA","FDAIEN","ERR")
+5 QUIT FDAIEN(1)
NEWCOL(RIEN,SEQ,NAM,WID) ; Add new format record for DEF
+1 NEW FDA,FDAIEN,DIERR,IENS,ERR
+2 SET IENS="+1,"_RIEN_","
+3 SET FDA(102.212,IENS,.01)=SEQ
+4 IF $LENGTH(NAM)
SET FDA(102.212,IENS,2)=NAM
+5 IF $LENGTH(WID)
SET FDA(102.212,IENS,3)=WID
+6 DO UPDATE^DIE("E","FDA","FDAIEN","ERR")
+7 QUIT FDAIEN(1)
OWNED(VAL,RPT) ; Return 1 is this report is owned by the current user
+1 SET VAL=0
+2 IF $PIECE($GET(^ORD(102.21,RPT,0)),U,5)=DUZ
SET VAL=1
+3 QUIT
DELETE(OK,DA) ; Delete a report
+1 NEW DIK
+2 SET DIK="^ORD(102.21,"
+3 DO ^DIK
+4 QUIT
