XUMFP513.m

XUMFP513 ;ALB/BRM - Master File Param COUNTY CODE ; 10/29/02 9:52am

 ;;8.0;KERNEL;**246**;Jul 10, 1995

 ;

 ;

 ; This routine sets up the parameters required by the COUNTY CODE

 ; (#5.13) file 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

 ;

 S PARAM("PRE")="PRE^XUMFP513"

 S PARAM("POST")="POST^XUMFP513"

 S TYPE=0

 ;

 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"))

 ;

 I QUERY D QRD

 ;

 ; MFI -- Master File Identification Segment

 S ^TMP("XUMF MFS",$J,"PARAM","MFI")="5P13"  ;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 Date/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")="UPD"

 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 ; -- LOC segment used for County Code File updates

 ;

 I IEN D

 .S PKV=$P($G(^XIP(5.13,+IEN,0)),U)

 .S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV  ; Primary Key Value

 I NEW D

 .S PKV="NEW"

 .S ^TMP("XUMF MFS",$J,"PARAM","PKV")=PKV  ; Primary Key Value

 ;

 ; LOC -- Location Identification Segment sequence

 S ^TMP("XUMF MFS",$J,"PARAM","SEGMENT")="LOC"

 ;   primary key value

 S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",1,.01)="PL"

 ;   location address (contains components utilizing XAD)

 ;   components and subcomponents are recognized by decimal SEQ values

 S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.4,2)="ZST"  ;state

 S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.8,1)="ST"  ;county

 S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.9,.01)="ST"  ;FIPS

 S ^TMP("XUMF MFS",$J,"PARAM","SEG","LOC","SEQ",5.12,"HLSCS",2,3)="DT"  ;inactive date

 ;

 Q:'GROUP

 Q:$G(HL("MTN"))="MFR"

 ;

GROUP ; -- query group

 ;

 S IEN=0

 F  S IEN=$O(^TMP("XUMF MFS",$J,"PARAM","IENS",IEN)) Q:'IEN  D

 .S PKV=$P(^XIP(5.13,IEN,0),U)

 .S ^TMP("XUMF MFS",$J,"PARAM",IEN,"PKV")=PKV

 ;

 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")="5P13 "_$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 - sta#, D x-ref, assigning facility

 I '$D(^TMP("XUMF MFS",$J,"PARAM","WHO")) D

 .N X S X=$S(ALL:"ALL",IEN:$P($G(^XIP(5.13,+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")="5.13"_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 ---XUMFP513   4641     printed  Feb 18, 2025@23:37:26                                                                                                                                                                                                    Page 2

XUMFP513  ;ALB/BRM - Master File Param COUNTY CODE ; 10/29/02 9:52am

 +1       ;;8.0;KERNEL;**246**;Jul 10, 1995

 +2       ;

 +3       ;

 +4       ; This routine sets up the parameters required by the COUNTY CODE

 +5       ; (#5.13) 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,PROTOCOL,HLFS,HLCS,RT,RF

 +12      ;

 +13       SET PARAM("PRE")="PRE^XUMFP513"

 +14       SET PARAM("POST")="POST^XUMFP513"

 +15       SET TYPE=0

 +16      ;

 +17       IF $ORDER(HL(""))=""

               Begin DoDot:1

 +18               if UPDATE

                       SET PROTOCOL=$ORDER(^ORD(101,"B","XUMF MFN",0))

 +19               if QUERY

                       SET PROTOCOL=$ORDER(^ORD(101,"B","XUMF MFQ",0))

 +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

 +28      ;

 +29      ; MFI -- Master File Identification Segment

 +30      ;Master File Identifier

           SET ^TMP("XUMF MFS",$JOB,"PARAM","MFI")="5P13"

 +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 Date/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")="UPD"

               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       ; -- LOC segment used for County Code File updates

 +1       ;

 +2        IF IEN

               Begin DoDot:1

 +3                SET PKV=$PIECE($GET(^XIP(5.13,+IEN,0)),U)

 +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"

 +7       ; Primary Key Value

                   SET ^TMP("XUMF MFS",$JOB,"PARAM","PKV")=PKV

               End DoDot:1

 +8       ;

 +9       ; LOC -- Location Identification Segment sequence

 +10       SET ^TMP("XUMF MFS",$JOB,"PARAM","SEGMENT")="LOC"

 +11      ;   primary key value

 +12       SET ^TMP("XUMF MFS",$JOB,"PARAM","SEG","LOC","SEQ",1,.01)="PL"

 +13      ;   location address (contains components utilizing XAD)

 +14      ;   components and subcomponents are recognized by decimal SEQ values

 +15      ;state

           SET ^TMP("XUMF MFS",$JOB,"PARAM","SEG","LOC","SEQ",5.4,2)="ZST"

 +16      ;county

           SET ^TMP("XUMF MFS",$JOB,"PARAM","SEG","LOC","SEQ",5.8,1)="ST"

 +17      ;FIPS

           SET ^TMP("XUMF MFS",$JOB,"PARAM","SEG","LOC","SEQ",5.9,.01)="ST"

 +18      ;inactive date

           SET ^TMP("XUMF MFS",$JOB,"PARAM","SEG","LOC","SEQ",5.12,"HLSCS",2,3)="DT"

 +19      ;

 +20       if 'GROUP

               QUIT 

 +21       if $GET(HL("MTN"))="MFR"

               QUIT 

 +22      ;

GROUP     ; -- query group

 +1       ;

 +2        SET IEN=0

 +3        FOR 

               SET IEN=$ORDER(^TMP("XUMF MFS",$JOB,"PARAM","IENS",IEN))

               if 'IEN

                   QUIT 

               Begin DoDot:1

 +4                SET PKV=$PIECE(^XIP(5.13,IEN,0),U)

 +5                SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"PKV")=PKV

               End DoDot:1

 +6       ;

 +7        QUIT 

 +8       ;

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")="5P13 "_$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_999

               End DoDot:1

 +29      ;

 +30      ;Who Subject Filter - sta#, D x-ref, assigning facility

 +31       IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","WHO"))

               Begin DoDot:1

 +32               NEW X

                   SET X=$SELECT(ALL:"ALL",IEN:$PIECE($GET(^XIP(5.13,+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")="5.13"_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       ;