- 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 Mar 13, 2025@21:15:50 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 ;
