XUMFP4 ;CIOFO-SF/RAM - Master File C/S Params INSTITUTION ;06/28/00
;;8.0;KERNEL;**206,217,294,335,416**;Jul 10, 1995;Build 5
;
;
; This routine sets up the parameters required by the INSTITUTION (#4)
; file for the Master File server mechanism.
;
; ** This routine is not a supported interface -- use XUMFP **
;
; See XUMFP for parameter list documentation
;
N PKV,HLFS,HLCS,RT,RF,NPI,TAX
;
S ^TMP("XUMF MFS",$J,"PARAM","PRE")="PRE^XUMFP4C"
S ^TMP("XUMF MFS",$J,"PARAM","POST")="POST^XUMFP4C"
;
I $O(HL(""))="" D
.I 'PROTOCOL 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"))
;
I QUERY D QRD^XUMFP4C
;
; MFI -- Master File Identification Segment
S ^TMP("XUMF MFS",$J,"PARAM","MFI")="Z04" ;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 ; -- ZIN segment
;
S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",8)=""
S ^TMP("XUMF MFS",$J,"PARAM","MKEY","ZIN",8)="VISN"
S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",9)=""
S ^TMP("XUMF MFS",$J,"PARAM","MKEY","ZIN",9)="PARENT FACILITY"
;history
S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",10)=10
S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",11)=10
S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",12)=12
S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",13)=12
;npi
S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",17)=17
S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",18)=17
S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",19)=17
;taxonomy
S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",20)=20
S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",21)=20
S ^TMP("XUMF MFS",$J,"PARAM","MULT","ZIN",22)=20
;
I IEN D
.I $G(^DIC(4,IEN,99)) D
..S PKV=$P(^DIC(4,IEN,99),U)_HLCS_"STATION NUMBER"_HLCS_"D"
.I 'PKV,CDSYS'="" D
..I CDSYS="NPI" D
...S $P(PKV,HLCS,1)=+$$NPI^XUSNPI("Organization_ID",IEN)
..S $P(PKV,HLCS,2)=$P($G(^DIC(4,+IEN,0)),U),$P(PKV,HLCS,3)=CDSYS
.S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV ; Primary Key Value
.S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",8)="1,"_IEN_","
.;S ^TMP("XUMF MFS",$J,"PARAM","KEY","ZIN",4.014,"1,"_IEN_",")="VISN"
.S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",9)="2,"_IEN_","
.;S ^TMP("XUMF MFS",$J,"PARAM","KEY","ZIN",4.014,"2,"_IEN_",")="PARENT FACILITY"
.S RF=$$RF^XUAF4(IEN) D:RF
..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",10)=$P(RF,U,3)_","_IEN_","
..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",11)=$P(RF,U,3)_","_IEN_","
..;S ^TMP("XUMF MFS",$J,"PARAM","KEY","ZIN",4.999,$P(RF,U,3)_","_IEN_",")=$P(RF,U,3)
.S RT=$$RT^XUAF4(IEN) D:RT
..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",12)=$P(RT,U,3)_","_IEN_","
..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",13)=$P(RT,U,3)_","_IEN_","
..;S ^TMP("XUMF MFS",$J,"PARAM","KEY","ZIN",4.999,$P(RT,U,3)_","_IEN_",")=$P(RT,U,3)
.S NPI=$$NPI^XUSNPI("Organization_ID",IEN) D:NPI
..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",17)=$O(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",18)=$O(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",19)=$O(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
.S TAX=$$TAXORG^XUSTAX(IEN) D:TAX
..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",20)=$O(^DIC(4,IEN,"TAXONOMY","B",+$P(TAX,U,2),999),-1)_","_IEN_","
..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",21)=$O(^DIC(4,IEN,"TAXONOMY","B",+$P(TAX,U,2),999),-1)_","_IEN_","
..S ^TMP("XUMF MFS",$J,"PARAM","IENS","ZIN",22)=$O(^DIC(4,IEN,"TAXONOMY","B",+$P(TAX,U,2),999),-1)_","_IEN_","
;
I NEW D
.S PKV="NEW"_HLCS_"STATION NUMBER"_HLCS_"D"
.S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV ; Primary Key Value
;
D ^XUMFP4Z
;
GROUP ; -- query group
;
D GROUP^XUMFP4C
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMFP4 4593 printed Dec 13, 2024@02:10:56 Page 2
XUMFP4 ;CIOFO-SF/RAM - Master File C/S Params INSTITUTION ;06/28/00
+1 ;;8.0;KERNEL;**206,217,294,335,416**;Jul 10, 1995;Build 5
+2 ;
+3 ;
+4 ; This routine sets up the parameters required by the INSTITUTION (#4)
+5 ; file for the Master File server mechanism.
+6 ;
+7 ; ** This routine is not a supported interface -- use XUMFP **
+8 ;
+9 ; See XUMFP for parameter list documentation
+10 ;
+11 NEW PKV,HLFS,HLCS,RT,RF,NPI,TAX
+12 ;
+13 SET ^TMP("XUMF MFS",$JOB,"PARAM","PRE")="PRE^XUMFP4C"
+14 SET ^TMP("XUMF MFS",$JOB,"PARAM","POST")="POST^XUMFP4C"
+15 ;
+16 IF $ORDER(HL(""))=""
Begin DoDot:1
+17 IF 'PROTOCOL
Begin DoDot:2
+18 if UPDATE
SET PROTOCOL=$ORDER(^ORD(101,"B","XUMF MFN",0))
+19 if QUERY
SET PROTOCOL=$ORDER(^ORD(101,"B","XUMF MFQ",0))
End DoDot:2
+20 if 'PROTOCOL
SET ERROR="1^invalid protocol"
if ERROR
QUIT
+21 SET ^TMP("XUMF MFS",$JOB,"PARAM","PROTOCOL")=PROTOCOL
+22 DO INIT^HLFNC2(PROTOCOL,.HL)
End DoDot:1
+23 ;
+24 IF $ORDER(HL(""))=""
SET ERROR="1^"_$PIECE(HL,U,2)
QUIT
+25 SET HLFS=HL("FS")
SET HLCS=$EXTRACT(HL("ECH"))
+26 ;
+27 IF QUERY
DO QRD^XUMFP4C
+28 ;
+29 ; MFI -- Master File Identification Segment
+30 ;Master File Identifier
SET ^TMP("XUMF MFS",$JOB,"PARAM","MFI")="Z04"
+31 ;Application Identifier
SET ^TMP("XUMF MFS",$JOB,"PARAM","MFAI")=""
+32 ;File-Level Event Code
SET ^TMP("XUMF MFS",$JOB,"PARAM","FLEC")="UPD"
+33 ;Entered Data/Time
SET ^TMP("XUMF MFS",$JOB,"PARAM","ENDT")=""
+34 ;Effective Date/Time
SET ^TMP("XUMF MFS",$JOB,"PARAM","MFIEDT")=""
+35 ;Response Level Code
SET ^TMP("XUMF MFS",$JOB,"PARAM","RLC")="NE"
+36 ;
+37 ; MFE -- Master File Entry
+38 ;Record-Level Event Code
IF $GET(^TMP("XUMF MFS",$JOB,"PARAM","RLEC"))=""
Begin DoDot:1
+39 SET ^TMP("XUMF MFS",$JOB,"PARAM","RLEC")="MUP"
End DoDot:1
+40 ;MFN Control ID
SET ^TMP("XUMF MFS",$JOB,"PARAM","MFNCID")=""
+41 ;Effective Date/Time
IF $GET(^TMP("XUMF MFS",$JOB,"PARAM","MFEEDT"))=""
Begin DoDot:1
+42 SET ^TMP("XUMF MFS",$JOB,"PARAM","MFEEDT")=$$HLDATE^HLFNC($$NOW^XLFDT)
End DoDot:1
+43 ;
SEG ; -- ZIN segment
+1 ;
+2 SET ^TMP("XUMF MFS",$JOB,"PARAM","MULT","ZIN",8)=""
+3 SET ^TMP("XUMF MFS",$JOB,"PARAM","MKEY","ZIN",8)="VISN"
+4 SET ^TMP("XUMF MFS",$JOB,"PARAM","MULT","ZIN",9)=""
+5 SET ^TMP("XUMF MFS",$JOB,"PARAM","MKEY","ZIN",9)="PARENT FACILITY"
+6 ;history
+7 SET ^TMP("XUMF MFS",$JOB,"PARAM","MULT","ZIN",10)=10
+8 SET ^TMP("XUMF MFS",$JOB,"PARAM","MULT","ZIN",11)=10
+9 SET ^TMP("XUMF MFS",$JOB,"PARAM","MULT","ZIN",12)=12
+10 SET ^TMP("XUMF MFS",$JOB,"PARAM","MULT","ZIN",13)=12
+11 ;npi
+12 SET ^TMP("XUMF MFS",$JOB,"PARAM","MULT","ZIN",17)=17
+13 SET ^TMP("XUMF MFS",$JOB,"PARAM","MULT","ZIN",18)=17
+14 SET ^TMP("XUMF MFS",$JOB,"PARAM","MULT","ZIN",19)=17
+15 ;taxonomy
+16 SET ^TMP("XUMF MFS",$JOB,"PARAM","MULT","ZIN",20)=20
+17 SET ^TMP("XUMF MFS",$JOB,"PARAM","MULT","ZIN",21)=20
+18 SET ^TMP("XUMF MFS",$JOB,"PARAM","MULT","ZIN",22)=20
+19 ;
+20 IF IEN
Begin DoDot:1
+21 IF $GET(^DIC(4,IEN,99))
Begin DoDot:2
+22 SET PKV=$PIECE(^DIC(4,IEN,99),U)_HLCS_"STATION NUMBER"_HLCS_"D"
End DoDot:2
+23 IF 'PKV
IF CDSYS'=""
Begin DoDot:2
+24 IF CDSYS="NPI"
Begin DoDot:3
+25 SET $PIECE(PKV,HLCS,1)=+$$NPI^XUSNPI("Organization_ID",IEN)
End DoDot:3
+26 SET $PIECE(PKV,HLCS,2)=$PIECE($GET(^DIC(4,+IEN,0)),U)
SET $PIECE(PKV,HLCS,3)=CDSYS
End DoDot:2
+27 ; Primary Key Value
SET ^TMP("XUMF MFS",$JOB,"PARAM","PKV")=PKV
+28 SET ^TMP("XUMF MFS",$JOB,"PARAM","IENS","ZIN",8)="1,"_IEN_","
+29 ;S ^TMP("XUMF MFS",$J,"PARAM","KEY","ZIN",4.014,"1,"_IEN_",")="VISN"
+30 SET ^TMP("XUMF MFS",$JOB,"PARAM","IENS","ZIN",9)="2,"_IEN_","
+31 ;S ^TMP("XUMF MFS",$J,"PARAM","KEY","ZIN",4.014,"2,"_IEN_",")="PARENT FACILITY"
+32 SET RF=$$RF^XUAF4(IEN)
if RF
Begin DoDot:2
+33 SET ^TMP("XUMF MFS",$JOB,"PARAM","IENS","ZIN",10)=$PIECE(RF,U,3)_","_IEN_","
+34 SET ^TMP("XUMF MFS",$JOB,"PARAM","IENS","ZIN",11)=$PIECE(RF,U,3)_","_IEN_","
+35 ;S ^TMP("XUMF MFS",$J,"PARAM","KEY","ZIN",4.999,$P(RF,U,3)_","_IEN_",")=$P(RF,U,3)
End DoDot:2
+36 SET RT=$$RT^XUAF4(IEN)
if RT
Begin DoDot:2
+37 SET ^TMP("XUMF MFS",$JOB,"PARAM","IENS","ZIN",12)=$PIECE(RT,U,3)_","_IEN_","
+38 SET ^TMP("XUMF MFS",$JOB,"PARAM","IENS","ZIN",13)=$PIECE(RT,U,3)_","_IEN_","
+39 ;S ^TMP("XUMF MFS",$J,"PARAM","KEY","ZIN",4.999,$P(RT,U,3)_","_IEN_",")=$P(RT,U,3)
End DoDot:2
+40 SET NPI=$$NPI^XUSNPI("Organization_ID",IEN)
if NPI
Begin DoDot:2
+41 SET ^TMP("XUMF MFS",$JOB,"PARAM","IENS","ZIN",17)=$ORDER(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
+42 SET ^TMP("XUMF MFS",$JOB,"PARAM","IENS","ZIN",18)=$ORDER(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
+43 SET ^TMP("XUMF MFS",$JOB,"PARAM","IENS","ZIN",19)=$ORDER(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
End DoDot:2
+44 SET TAX=$$TAXORG^XUSTAX(IEN)
if TAX
Begin DoDot:2
+45 SET ^TMP("XUMF MFS",$JOB,"PARAM","IENS","ZIN",20)=$ORDER(^DIC(4,IEN,"TAXONOMY","B",+$PIECE(TAX,U,2),999),-1)_","_IEN_","
+46 SET ^TMP("XUMF MFS",$JOB,"PARAM","IENS","ZIN",21)=$ORDER(^DIC(4,IEN,"TAXONOMY","B",+$PIECE(TAX,U,2),999),-1)_","_IEN_","
+47 SET ^TMP("XUMF MFS",$JOB,"PARAM","IENS","ZIN",22)=$ORDER(^DIC(4,IEN,"TAXONOMY","B",+$PIECE(TAX,U,2),999),-1)_","_IEN_","
End DoDot:2
End DoDot:1
+48 ;
+49 IF NEW
Begin DoDot:1
+50 SET PKV="NEW"_HLCS_"STATION NUMBER"_HLCS_"D"
+51 ; Primary Key Value
SET ^TMP("XUMF MFS",$JOB,"PARAM","PKV")=PKV
End DoDot:1
+52 ;
+53 DO ^XUMFP4Z
+54 ;
GROUP ; -- query group
+1 ;
+2 DO GROUP^XUMFP4C
+3 ;
+4 QUIT
+5 ;
