- 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 Jan 18, 2025@03:35:09 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