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

XUMFPMFS.m

Go to the documentation of this file. 
  1. XUMFPMFS ;CIOFO-SF/RAM - Master File Param GENERIC ;8/14/06
  1.  ;;8.0;KERNEL;**262,369**;Jul 10, 1995;Build 27
  1.  ;
  1.  ; This routine sets up the parameters required by the ZL7
  1.  ; for the Master File server mechanism.
  1.  ;
  1.  ;  ** This routine is not a supported interface -- use XUMFP **
  1.  ;
  1.  ;  See XUMFP for parameter list documentation
  1.  ;
  1.  N PKV,PROTOCOL,HLFS,HLCS,RT,RF,TABLE,TABNAM
  1.  ;
  1.  D FILE^DID(IFN,"","NAME","X")
  1.  S TABNAM=$S($G(X("NAME"))'="":X("NAME"),1:"NOTAB") K X
  1.  ;
  1.  S PARAM("PRE")="PRE^XUMFPMFS"
  1.  S PARAM("POST")="POST^XUMFPMFS"
  1.  ;
  1.  I $O(HL(""))="" D
  1.  .S:UPDATE PROTOCOL=$O(^ORD(101,"B","XUMF MFN",0))
  1.  .S:QUERY PROTOCOL=$O(^ORD(101,"B","XUMF MFQ",0))
  1.  .S:'PROTOCOL ERROR="1^invalid protocol" Q:ERROR
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","PROTOCOL")=PROTOCOL
  1.  .D INIT^HLFNC2(PROTOCOL,.HL)
  1.  ;
  1.  I $O(HL(""))="" S ERROR="1^"_$P(HL,U,2) Q
  1.  S HLFS=HL("FS"),HLCS=$E(HL("ECH"))
  1.  ;
  1.  D
  1.  .I IFN=4.11 S TABLE="ZAG" Q
  1.  .I IFN=5 S TABLE="Z05" Q
  1.  .I IFN=49 S TABLE="Z49" Q
  1.  .I IFN=9.8 S TABLE="ZRN" Q
  1.  .S TABLE="NOTAB" Q
  1.  ;
  1.  I QUERY D QRD
  1.  ;
  1.  ; MFI -- Master File Identification Segment
  1.  ;
  1.  S ^TMP("XUMF MFS",$J,"PARAM","MFI")=TABLE  ;Master File Identifier
  1.  S ^TMP("XUMF MFS",$J,"PARAM","MFAI")=""  ;Application Identifier
  1.  S ^TMP("XUMF MFS",$J,"PARAM","FLEC")="UPD"  ;File-Level Event Code
  1.  S ^TMP("XUMF MFS",$J,"PARAM","ENDT")=""  ;Entered Data/Time
  1.  S ^TMP("XUMF MFS",$J,"PARAM","MFIEDT")=""  ;Effective Date/Time
  1.  S ^TMP("XUMF MFS",$J,"PARAM","RLC")="NE"  ;Response Level Code
  1.  ;
  1.  ; MFE -- Master File Entry
  1.  I $G(^TMP("XUMF MFS",$J,"PARAM","RLEC"))="" D  ;Record-Level Event Code
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","RLEC")="MUP"
  1.  S ^TMP("XUMF MFS",$J,"PARAM","MFNCID")=""  ;MFN Control ID
  1.  I $G(^TMP("XUMF MFS",$J,"PARAM","MFEEDT"))="" D  ;Effective Date/Time
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","MFEEDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
  1.  ;
  1. SEG ; -- ZL7 segment
  1.  ;
  1.  I IEN D
  1.  .S PKV=$P($G(@ROOT@(+IEN,0)),U)_HLCS_TABNAM_HLCS_"B"
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV  ; Primary Key Value
  1.  I NEW D
  1.  .S PKV="NEW"_HLCS_TABNAM_HLCS_"B"
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV  ; Primary Key Value
  1.  ;
  1.  D @(TABLE_"^XUMFPZL7")
  1.  ;
  1.  Q:'GROUP
  1.  Q:$G(HL("MTN"))="MFR"
  1.  ;
  1. GROUP ; -- query group
  1.  ;
  1.  S IEN=0
  1.  F  S IEN=$O(^TMP("XUMF MFS",$J,"PARAM","IEN",IEN)) Q:'IEN  D
  1.  .S PKV=$P(@ROOT@(IEN,0),U)_HLCS_TABNAM_HLCS_"B"
  1.  .S ^TMP("XUMF MFS",$J,"PARAM",IEN,"PKV")=PKV
  1.  .I IFN=9.8 D
  1.  ..N X S X=$O(^DIC(9.8,IEN,8,0)) Q:'X
  1.  ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZL7",5)=X_","_IEN_","
  1.  ..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZL7",6)=X_","_IEN_","
  1.  ..F  S X=$O(^DIC(9.8,IEN,8,X)) Q:'X  D
  1.  ...S ^TMP("XUMF MFS",$J,"PARAM",IEN,"ROUTINE",5,X)=X_","_IEN_","
  1.  ...S ^TMP("XUMF MFS",$J,"PARAM",IEN,"ROUTINE",6,X)=X_","_IEN_","
  1.  ;
  1.  Q
  1.  ;
  1. QRD ; -- query definition segment
  1.  ;
  1.  ;Query Date/Time
  1.  I '$D(^TMP("XUMF MFS",$J,"PARAM","QDT")) D
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","QDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
  1.  ;
  1.  ;Query Format Code
  1.  I '$D(^TMP("XUMF MFS",$J,"PARAM","QFC")) D
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","QFC")="R"
  1.  ;
  1.  ;Query Priority
  1.  I '$D(^TMP("XUMF MFS",$J,"PARAM","QP")) D
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","QP")="I"
  1.  ;
  1.  ;Query ID
  1.  I '$D(^TMP("XUMF MFS",$J,"PARAM","QID")) D
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","QID")=TABLE_" "_$S(ARRAY:"ARRAY",1:"FILE")
  1.  ;
  1.  ;Deferred Response Type (optional)
  1.  I '$D(^TMP("XUMF MFS",$J,"PARAM","DRT")) D
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","DRT")=""
  1.  ;
  1.  ;Deferred Response Date/Time (optional)
  1.  I '$D(^TMP("XUMF MFS",$J,"PARAM","DRDT")) D
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","DRDT")=""
  1.  ;
  1.  ;Quantity Limited Request
  1.  I '$D(^TMP("XUMF MFS",$J,"PARAM","QLR")) D
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","QLR")="RD"_HLCS_99999
  1.  ;
  1.  ;Who Subject Filter
  1.  I '$D(^TMP("XUMF MFS",$J,"PARAM","WHO")) D
  1.  .N X S X=$S(ALL:"ALL",IEN:$P($G(@ROOT@(+IEN,0)),U),1:"IEN ARRAY")
  1.  .S $P(X,HLCS,9,10)="B"_HLCS_"VA"
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","WHO")=X
  1.  ;
  1.  ;What Subject Filter
  1.  I '$D(^TMP("XUMF MFS",$J,"PARAM","WHAT")) D
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","WHAT")=IFN_HLCS_"IFN"_HLCS_"VA FM"
  1.  ;
  1.  ;What Department Data Code
  1.  I '$D(^TMP("XUMF MFS",$J,"PARAM","WDDC")) D
  1.  .N X S X="INFRASTRUCTURE"_HLCS_"INFORMATION INFRASTRUCTURE"
  1.  .S X=X_HLCS_"VA TS"
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","WDDC")=X
  1.  ;
  1.  ;What Data Code Value Qual (optional)
  1.  I '$D(^TMP("XUMF MFS",$J,"PARAM","WDCVQ")) D
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","WDCVQ")=""
  1.  ;
  1.  ;Query Results Level (optional)
  1.  I '$D(^TMP("XUMF MFS",$J,"PARAM","QRL")) D
  1.  .S ^TMP("XUMF MFS",$J,"PARAM","QRL")=""
  1.  ;
  1.  Q
  1.  ;
  1. PRE ; -- pre-update record
  1.  ;
  1.  Q
  1.  ;
  1. POST ; -- post-update record
  1.  ;
  1.  Q
  1.  ;