XUMFXP2 ;ISS/RAM - MFS parameters query/group ;06/28/00
;;8.0;KERNEL;**299**;Jul 10, 1995
;
; this routine is a called by XUMFXP1 and is a continuation of that
; routine
;
Q
;
MAIN ; -- main
;
N X
;
QRD ; -- query definition segment
;
;Query Date/Time
I '$D(^TMP("XUMF MFS",$J,"PARAM","QDT")) D
.S ^TMP("XUMF MFS",$J,"PARAM","QDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
;
;Query Format Code
I '$D(^TMP("XUMF MFS",$J,"PARAM","QFC")) D
.S ^TMP("XUMF MFS",$J,"PARAM","QFC")="R"
;
;Query Priority
I '$D(^TMP("XUMF MFS",$J,"PARAM","QP")) D
.S ^TMP("XUMF MFS",$J,"PARAM","QP")="I"
;
;Query ID
I '$D(^TMP("XUMF MFS",$J,"PARAM","QID")) D
.S X=$P($G(^DIC(4.001,+IFN,0)),U,3)
.S ^TMP("XUMF MFS",$J,"PARAM","QID")=X_$S(ARRAY:" ARRAY",1:" FILE")
;
;Deferred Response Type (optional)
I '$D(^TMP("XUMF MFS",$J,"PARAM","DRT")) D
.S ^TMP("XUMF MFS",$J,"PARAM","DRT")=""
;
;Deferred Response Date/Time (optional)
I '$D(^TMP("XUMF MFS",$J,"PARAM","DRDT")) D
.S ^TMP("XUMF MFS",$J,"PARAM","DRDT")=""
;
;Quantity Limited Request
I '$D(^TMP("XUMF MFS",$J,"PARAM","QLR")) D
.S ^TMP("XUMF MFS",$J,"PARAM","QLR")="RD"_HLCS_999
;
;Who Subject Filter - ID, source table (use x-ref), assigning authority
I '$D(^TMP("XUMF MFS",$J,"PARAM","WHO")) D
.N PKV,XREF,AA
.S PKV=$$PKV^XUMFX(IFN,IEN,HLCS)
.S XREF=$P($G(^DIC(4.001,+IFN,"MFE")),U,8)
.S AA=$P($G(^DIC(4.001,+IFN,"MFE")),U,9)
.N X S X=$S(ALL:"ALL",IEN:$P(PKV,HLCS),1:"IEN ARRAY")
.S $P(X,HLCS,9,10)=XREF_HLCS_AA
.S ^TMP("XUMF MFS",$J,"PARAM","WHO")=X
;
;What Subject Filter
I '$D(^TMP("XUMF MFS",$J,"PARAM","WHAT")) D
.S ^TMP("XUMF MFS",$J,"PARAM","WHAT")=IFN_HLCS_"IFN"_HLCS_"VA FM"
;
;What Department Data Code
I '$D(^TMP("XUMF MFS",$J,"PARAM","WDDC")) D
.N X S X="INFRASTRUCTURE"_HLCS_"INFORMATION INFRASTRUCTURE"
.S X=X_HLCS_"VA TS"
.S ^TMP("XUMF MFS",$J,"PARAM","WDDC")=X
;
;What Data Code Value Qual (optional)
I '$D(^TMP("XUMF MFS",$J,"PARAM","WDCVQ")) D
.S ^TMP("XUMF MFS",$J,"PARAM","WDCVQ")=""
;
;Query Results Level (optional)
I '$D(^TMP("XUMF MFS",$J,"PARAM","QRL")) D
.S ^TMP("XUMF MFS",$J,"PARAM","QRL")=""
;
Q
;
GROUP ; -- query group
;
N XXX,IDX,SEQ
;
S (IDX,SEQ)=0
F S IDX=$O(^DIC(4.001,IFN,1,IDX)) Q:'IDX D
.S SEQ=SEQ+1
.N FUNC,SUBFILE,X,Y
.S Y=$G(^DIC(4.001,+IFN,1,+IDX,0))
.S SUBFILE=$P(Y,U,4)
.Q:'SUBFILE
.S FUNC=$P(Y,U,8)
.I 'FUNC,FUNC'="" D
..I FUNC'["(" S FUNC="$$"_FUNC_"^XUMFF" Q
..S FUNC="$$"_$P(FUNC,"(")_"^XUMFF("_$P(FUNC,"(",2)
..S XXX(SEQ)=FUNC
;
S IEN=0
F S IEN=$O(^TMP("XUMF MFS",$J,"PARAM","IEN",IEN)) Q:'IEN D
.S PKV=$$PKV^XUMFX(IFN,IEN,HLCS)
.I CDSYS'="" D
..S $P(PKV,HLCS,1)=^TMP("XUMF MFS",$J,"PARAM","IEN",IEN)
..S $P(PKV,HLCS,2)=$P($G(@ROOT@(+IEN,0)),U)
..S $P(PKV,HLCS,3)=CDSYS
.S ^TMP("XUMF MFS",$J,"PARAM",IEN,"PKV")=PKV
.;
.S SEQ=0
.F S SEQ=$O(XXX(SEQ)) Q:'SEQ D
..S FUNC=XXX(SEQ)
..S X="S X="_FUNC X X
..Q:'X
..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS",SEQ)=X_","_IEN_","
;
Q
;
XUMFXP2 ;ISS/RAM - MFS parameters query/group ;06/28/00
+1 ;;8.0;KERNEL;**299**;Jul 10, 1995
+2 ;
+3 ; this routine is a called by XUMFXP1 and is a continuation of that
+4 ; routine
+5 ;
+6 QUIT
+7 ;
MAIN ; -- main
+1 ;
+2 NEW X
+3 ;
QRD ; -- query definition segment
+1 ;
+2 ;Query Date/Time
+3 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","QDT"))
Begin DoDot:1
+4 SET ^TMP("XUMF MFS",$JOB,"PARAM","QDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
End DoDot:1
+5 ;
+6 ;Query Format Code
+7 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","QFC"))
Begin DoDot:1
+8 SET ^TMP("XUMF MFS",$JOB,"PARAM","QFC")="R"
End DoDot:1
+9 ;
+10 ;Query Priority
+11 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","QP"))
Begin DoDot:1
+12 SET ^TMP("XUMF MFS",$JOB,"PARAM","QP")="I"
End DoDot:1
+13 ;
+14 ;Query ID
+15 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","QID"))
Begin DoDot:1
+16 SET X=$PIECE($GET(^DIC(4.001,+IFN,0)),U,3)
+17 SET ^TMP("XUMF MFS",$JOB,"PARAM","QID")=X_$SELECT(ARRAY:" ARRAY",1:" FILE")
End DoDot:1
+18 ;
+19 ;Deferred Response Type (optional)
+20 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","DRT"))
Begin DoDot:1
+21 SET ^TMP("XUMF MFS",$JOB,"PARAM","DRT")=""
End DoDot:1
+22 ;
+23 ;Deferred Response Date/Time (optional)
+24 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","DRDT"))
Begin DoDot:1
+25 SET ^TMP("XUMF MFS",$JOB,"PARAM","DRDT")=""
End DoDot:1
+26 ;
+27 ;Quantity Limited Request
+28 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","QLR"))
Begin DoDot:1
+29 SET ^TMP("XUMF MFS",$JOB,"PARAM","QLR")="RD"_HLCS_999
End DoDot:1
+30 ;
+31 ;Who Subject Filter - ID, source table (use x-ref), assigning authority
+32 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","WHO"))
Begin DoDot:1
+33 NEW PKV,XREF,AA
+34 SET PKV=$$PKV^XUMFX(IFN,IEN,HLCS)
+35 SET XREF=$PIECE($GET(^DIC(4.001,+IFN,"MFE")),U,8)
+36 SET AA=$PIECE($GET(^DIC(4.001,+IFN,"MFE")),U,9)
+37 NEW X
SET X=$SELECT(ALL:"ALL",IEN:$PIECE(PKV,HLCS),1:"IEN ARRAY")
+38 SET $PIECE(X,HLCS,9,10)=XREF_HLCS_AA
+39 SET ^TMP("XUMF MFS",$JOB,"PARAM","WHO")=X
End DoDot:1
+40 ;
+41 ;What Subject Filter
+42 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","WHAT"))
Begin DoDot:1
+43 SET ^TMP("XUMF MFS",$JOB,"PARAM","WHAT")=IFN_HLCS_"IFN"_HLCS_"VA FM"
End DoDot:1
+44 ;
+45 ;What Department Data Code
+46 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","WDDC"))
Begin DoDot:1
+47 NEW X
SET X="INFRASTRUCTURE"_HLCS_"INFORMATION INFRASTRUCTURE"
+48 SET X=X_HLCS_"VA TS"
+49 SET ^TMP("XUMF MFS",$JOB,"PARAM","WDDC")=X
End DoDot:1
+50 ;
+51 ;What Data Code Value Qual (optional)
+52 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","WDCVQ"))
Begin DoDot:1
+53 SET ^TMP("XUMF MFS",$JOB,"PARAM","WDCVQ")=""
End DoDot:1
+54 ;
+55 ;Query Results Level (optional)
+56 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","QRL"))
Begin DoDot:1
+57 SET ^TMP("XUMF MFS",$JOB,"PARAM","QRL")=""
End DoDot:1
+58 ;
+59 QUIT
+60 ;
GROUP ; -- query group
+1 ;
+2 NEW XXX,IDX,SEQ
+3 ;
+4 SET (IDX,SEQ)=0
+5 FOR
SET IDX=$ORDER(^DIC(4.001,IFN,1,IDX))
IF 'IDX
QUIT
Begin DoDot:1
+6 SET SEQ=SEQ+1
+7 NEW FUNC,SUBFILE,X,Y
+8 SET Y=$GET(^DIC(4.001,+IFN,1,+IDX,0))
+9 SET SUBFILE=$PIECE(Y,U,4)
+10 IF 'SUBFILE
QUIT
+11 SET FUNC=$PIECE(Y,U,8)
+12 IF 'FUNC
IF FUNC'=""
Begin DoDot:2
+13 IF FUNC'["("
SET FUNC="$$"_FUNC_"^XUMFF"
QUIT
+14 SET FUNC="$$"_$PIECE(FUNC,"(")_"^XUMFF("_$PIECE(FUNC,"(",2)
+15 SET XXX(SEQ)=FUNC
End DoDot:2
End DoDot:1
+16 ;
+17 SET IEN=0
+18 FOR
SET IEN=$ORDER(^TMP("XUMF MFS",$JOB,"PARAM","IEN",IEN))
IF 'IEN
QUIT
Begin DoDot:1
+19 SET PKV=$$PKV^XUMFX(IFN,IEN,HLCS)
+20 IF CDSYS'=""
Begin DoDot:2
+21 SET $PIECE(PKV,HLCS,1)=^TMP("XUMF MFS",$JOB,"PARAM","IEN",IEN)
+22 SET $PIECE(PKV,HLCS,2)=$PIECE($GET(@ROOT@(+IEN,0)),U)
+23 SET $PIECE(PKV,HLCS,3)=CDSYS
End DoDot:2
+24 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"PKV")=PKV
+25 ;
+26 SET SEQ=0
+27 FOR
SET SEQ=$ORDER(XXX(SEQ))
IF 'SEQ
QUIT
Begin DoDot:2
+28 SET FUNC=XXX(SEQ)
+29 SET X="S X="_FUNC
XECUTE X
+30 IF 'X
QUIT
+31 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"IENS",SEQ)=X_","_IEN_","
End DoDot:2
End DoDot:1
+32 ;
+33 QUIT
+34 ;
