XUMFPMFS ;CIOFO-SF/RAM - Master File Param GENERIC ;8/14/06
;;8.0;KERNEL;**262,369**;Jul 10, 1995;Build 27
;
; This routine sets up the parameters required by the ZL7
; for the Master File server mechanism.
;
; ** This routine is not a supported interface -- use XUMFP **
;
; See XUMFP for parameter list documentation
;
N PKV,PROTOCOL,HLFS,HLCS,RT,RF,TABLE,TABNAM
;
D FILE^DID(IFN,"","NAME","X")
S TABNAM=$S($G(X("NAME"))'="":X("NAME"),1:"NOTAB") K X
;
S PARAM("PRE")="PRE^XUMFPMFS"
S PARAM("POST")="POST^XUMFPMFS"
;
I $O(HL(""))="" D
.S:UPDATE PROTOCOL=$O(^ORD(101,"B","XUMF MFN",0))
.S:QUERY PROTOCOL=$O(^ORD(101,"B","XUMF MFQ",0))
.S:'PROTOCOL ERROR="1^invalid protocol" Q:ERROR
.S ^TMP("XUMF MFS",$J,"PARAM","PROTOCOL")=PROTOCOL
.D INIT^HLFNC2(PROTOCOL,.HL)
;
I $O(HL(""))="" S ERROR="1^"_$P(HL,U,2) Q
S HLFS=HL("FS"),HLCS=$E(HL("ECH"))
;
D
.I IFN=4.11 S TABLE="ZAG" Q
.I IFN=5 S TABLE="Z05" Q
.I IFN=49 S TABLE="Z49" Q
.I IFN=9.8 S TABLE="ZRN" Q
.S TABLE="NOTAB" Q
;
I QUERY D QRD
;
; MFI -- Master File Identification Segment
;
S ^TMP("XUMF MFS",$J,"PARAM","MFI")=TABLE ;Master File Identifier
S ^TMP("XUMF MFS",$J,"PARAM","MFAI")="" ;Application Identifier
S ^TMP("XUMF MFS",$J,"PARAM","FLEC")="UPD" ;File-Level Event Code
S ^TMP("XUMF MFS",$J,"PARAM","ENDT")="" ;Entered Data/Time
S ^TMP("XUMF MFS",$J,"PARAM","MFIEDT")="" ;Effective Date/Time
S ^TMP("XUMF MFS",$J,"PARAM","RLC")="NE" ;Response Level Code
;
; MFE -- Master File Entry
I $G(^TMP("XUMF MFS",$J,"PARAM","RLEC"))="" D ;Record-Level Event Code
.S ^TMP("XUMF MFS",$J,"PARAM","RLEC")="MUP"
S ^TMP("XUMF MFS",$J,"PARAM","MFNCID")="" ;MFN Control ID
I $G(^TMP("XUMF MFS",$J,"PARAM","MFEEDT"))="" D ;Effective Date/Time
.S ^TMP("XUMF MFS",$J,"PARAM","MFEEDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
;
SEG ; -- ZL7 segment
;
I IEN D
.S PKV=$P($G(@ROOT@(+IEN,0)),U)_HLCS_TABNAM_HLCS_"B"
.S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV ; Primary Key Value
I NEW D
.S PKV="NEW"_HLCS_TABNAM_HLCS_"B"
.S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV ; Primary Key Value
;
D @(TABLE_"^XUMFPZL7")
;
Q:'GROUP
Q:$G(HL("MTN"))="MFR"
;
GROUP ; -- query group
;
S IEN=0
F S IEN=$O(^TMP("XUMF MFS",$J,"PARAM","IEN",IEN)) Q:'IEN D
.S PKV=$P(@ROOT@(IEN,0),U)_HLCS_TABNAM_HLCS_"B"
.S ^TMP("XUMF MFS",$J,"PARAM",IEN,"PKV")=PKV
.I IFN=9.8 D
..N X S X=$O(^DIC(9.8,IEN,8,0)) Q:'X
..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZL7",5)=X_","_IEN_","
..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZL7",6)=X_","_IEN_","
..F S X=$O(^DIC(9.8,IEN,8,X)) Q:'X D
...S ^TMP("XUMF MFS",$J,"PARAM",IEN,"ROUTINE",5,X)=X_","_IEN_","
...S ^TMP("XUMF MFS",$J,"PARAM",IEN,"ROUTINE",6,X)=X_","_IEN_","
;
Q
;
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 ^TMP("XUMF MFS",$J,"PARAM","QID")=TABLE_" "_$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_99999
;
;Who Subject Filter
I '$D(^TMP("XUMF MFS",$J,"PARAM","WHO")) D
.N X S X=$S(ALL:"ALL",IEN:$P($G(@ROOT@(+IEN,0)),U),1:"IEN ARRAY")
.S $P(X,HLCS,9,10)="B"_HLCS_"VA"
.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
;
PRE ; -- pre-update record
;
Q
;
POST ; -- post-update record
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMFPMFS 4620 printed Apr 09, 2024@21:16:39 Page 2
XUMFPMFS ;CIOFO-SF/RAM - Master File Param GENERIC ;8/14/06
+1 ;;8.0;KERNEL;**262,369**;Jul 10, 1995;Build 27
+2 ;
+3 ; This routine sets up the parameters required by the ZL7
+4 ; for the Master File server mechanism.
+5 ;
+6 ; ** This routine is not a supported interface -- use XUMFP **
+7 ;
+8 ; See XUMFP for parameter list documentation
+9 ;
+10 NEW PKV,PROTOCOL,HLFS,HLCS,RT,RF,TABLE,TABNAM
+11 ;
+12 DO FILE^DID(IFN,"","NAME","X")
+13 SET TABNAM=$SELECT($GET(X("NAME"))'="":X("NAME"),1:"NOTAB")
KILL X
+14 ;
+15 SET PARAM("PRE")="PRE^XUMFPMFS"
+16 SET PARAM("POST")="POST^XUMFPMFS"
+17 ;
+18 IF $ORDER(HL(""))=""
Begin DoDot:1
+19 if UPDATE
SET PROTOCOL=$ORDER(^ORD(101,"B","XUMF MFN",0))
+20 if QUERY
SET PROTOCOL=$ORDER(^ORD(101,"B","XUMF MFQ",0))
+21 if 'PROTOCOL
SET ERROR="1^invalid protocol"
if ERROR
QUIT
+22 SET ^TMP("XUMF MFS",$JOB,"PARAM","PROTOCOL")=PROTOCOL
+23 DO INIT^HLFNC2(PROTOCOL,.HL)
End DoDot:1
+24 ;
+25 IF $ORDER(HL(""))=""
SET ERROR="1^"_$PIECE(HL,U,2)
QUIT
+26 SET HLFS=HL("FS")
SET HLCS=$EXTRACT(HL("ECH"))
+27 ;
+28 Begin DoDot:1
+29 IF IFN=4.11
SET TABLE="ZAG"
QUIT
+30 IF IFN=5
SET TABLE="Z05"
QUIT
+31 IF IFN=49
SET TABLE="Z49"
QUIT
+32 IF IFN=9.8
SET TABLE="ZRN"
QUIT
+33 SET TABLE="NOTAB"
QUIT
End DoDot:1
+34 ;
+35 IF QUERY
DO QRD
+36 ;
+37 ; MFI -- Master File Identification Segment
+38 ;
+39 ;Master File Identifier
SET ^TMP("XUMF MFS",$JOB,"PARAM","MFI")=TABLE
+40 ;Application Identifier
SET ^TMP("XUMF MFS",$JOB,"PARAM","MFAI")=""
+41 ;File-Level Event Code
SET ^TMP("XUMF MFS",$JOB,"PARAM","FLEC")="UPD"
+42 ;Entered Data/Time
SET ^TMP("XUMF MFS",$JOB,"PARAM","ENDT")=""
+43 ;Effective Date/Time
SET ^TMP("XUMF MFS",$JOB,"PARAM","MFIEDT")=""
+44 ;Response Level Code
SET ^TMP("XUMF MFS",$JOB,"PARAM","RLC")="NE"
+45 ;
+46 ; MFE -- Master File Entry
+47 ;Record-Level Event Code
IF $GET(^TMP("XUMF MFS",$JOB,"PARAM","RLEC"))=""
Begin DoDot:1
+48 SET ^TMP("XUMF MFS",$JOB,"PARAM","RLEC")="MUP"
End DoDot:1
+49 ;MFN Control ID
SET ^TMP("XUMF MFS",$JOB,"PARAM","MFNCID")=""
+50 ;Effective Date/Time
IF $GET(^TMP("XUMF MFS",$JOB,"PARAM","MFEEDT"))=""
Begin DoDot:1
+51 SET ^TMP("XUMF MFS",$JOB,"PARAM","MFEEDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
End DoDot:1
+52 ;
SEG ; -- ZL7 segment
+1 ;
+2 IF IEN
Begin DoDot:1
+3 SET PKV=$PIECE($GET(@ROOT@(+IEN,0)),U)_HLCS_TABNAM_HLCS_"B"
+4 ; Primary Key Value
SET ^TMP("XUMF MFS",$JOB,"PARAM","PKV")=PKV
End DoDot:1
+5 IF NEW
Begin DoDot:1
+6 SET PKV="NEW"_HLCS_TABNAM_HLCS_"B"
+7 ; Primary Key Value
SET ^TMP("XUMF MFS",$JOB,"PARAM","PKV")=PKV
End DoDot:1
+8 ;
+9 DO @(TABLE_"^XUMFPZL7")
+10 ;
+11 if 'GROUP
QUIT
+12 if $GET(HL("MTN"))="MFR"
QUIT
+13 ;
GROUP ; -- query group
+1 ;
+2 SET IEN=0
+3 FOR
SET IEN=$ORDER(^TMP("XUMF MFS",$JOB,"PARAM","IEN",IEN))
if 'IEN
QUIT
Begin DoDot:1
+4 SET PKV=$PIECE(@ROOT@(IEN,0),U)_HLCS_TABNAM_HLCS_"B"
+5 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"PKV")=PKV
+6 IF IFN=9.8
Begin DoDot:2
+7 NEW X
SET X=$ORDER(^DIC(9.8,IEN,8,0))
if 'X
QUIT
+8 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"IENS","ZL7",5)=X_","_IEN_","
+9 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"IENS","ZL7",6)=X_","_IEN_","
+10 FOR
SET X=$ORDER(^DIC(9.8,IEN,8,X))
if 'X
QUIT
Begin DoDot:3
+11 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"ROUTINE",5,X)=X_","_IEN_","
+12 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"ROUTINE",6,X)=X_","_IEN_","
End DoDot:3
End DoDot:2
End DoDot:1
+13 ;
+14 QUIT
+15 ;
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 ^TMP("XUMF MFS",$JOB,"PARAM","QID")=TABLE_" "_$SELECT(ARRAY:"ARRAY",1:"FILE")
End DoDot:1
+17 ;
+18 ;Deferred Response Type (optional)
+19 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","DRT"))
Begin DoDot:1
+20 SET ^TMP("XUMF MFS",$JOB,"PARAM","DRT")=""
End DoDot:1
+21 ;
+22 ;Deferred Response Date/Time (optional)
+23 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","DRDT"))
Begin DoDot:1
+24 SET ^TMP("XUMF MFS",$JOB,"PARAM","DRDT")=""
End DoDot:1
+25 ;
+26 ;Quantity Limited Request
+27 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","QLR"))
Begin DoDot:1
+28 SET ^TMP("XUMF MFS",$JOB,"PARAM","QLR")="RD"_HLCS_99999
End DoDot:1
+29 ;
+30 ;Who Subject Filter
+31 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","WHO"))
Begin DoDot:1
+32 NEW X
SET X=$SELECT(ALL:"ALL",IEN:$PIECE($GET(@ROOT@(+IEN,0)),U),1:"IEN ARRAY")
+33 SET $PIECE(X,HLCS,9,10)="B"_HLCS_"VA"
+34 SET ^TMP("XUMF MFS",$JOB,"PARAM","WHO")=X
End DoDot:1
+35 ;
+36 ;What Subject Filter
+37 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","WHAT"))
Begin DoDot:1
+38 SET ^TMP("XUMF MFS",$JOB,"PARAM","WHAT")=IFN_HLCS_"IFN"_HLCS_"VA FM"
End DoDot:1
+39 ;
+40 ;What Department Data Code
+41 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","WDDC"))
Begin DoDot:1
+42 NEW X
SET X="INFRASTRUCTURE"_HLCS_"INFORMATION INFRASTRUCTURE"
+43 SET X=X_HLCS_"VA TS"
+44 SET ^TMP("XUMF MFS",$JOB,"PARAM","WDDC")=X
End DoDot:1
+45 ;
+46 ;What Data Code Value Qual (optional)
+47 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","WDCVQ"))
Begin DoDot:1
+48 SET ^TMP("XUMF MFS",$JOB,"PARAM","WDCVQ")=""
End DoDot:1
+49 ;
+50 ;Query Results Level (optional)
+51 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","QRL"))
Begin DoDot:1
+52 SET ^TMP("XUMF MFS",$JOB,"PARAM","QRL")=""
End DoDot:1
+53 ;
+54 QUIT
+55 ;
PRE ; -- pre-update record
+1 ;
+2 QUIT
+3 ;
POST ; -- post-update record
+1 ;
+2 QUIT
+3 ;
