XUMFP4C ;CIOFO-SF/RAM - Master File C/S Params INSTITUTION ;06/28/00
;;8.0;KERNEL;**206,209,217,270,294,335,390,416**;Jul 10, 1995;Build 5
;
; this routine is a called by XUMFP4 and is a continuation of that
; routine
;
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")="Z04 "_$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(^DIC(4,+IEN,99)),U),1:"IEN ARRAY")
.S $P(X,HLCS,9,10)="D"_HLCS_"045A4"
.S:$G(CDSYS)'="" $P(X,HLCS,9,10)=CDSYS_HLCS_""
.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")="4"_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
;
D PRE^XUMFR
;
D IFF(IEN)
;
Q
;
POST ; -- post-update record
;
D POST^XUMFR
;
Q
;
GROUP ; -- query group
;
S IEN=0
F S IEN=$O(^TMP("XUMF MFS",$J,"PARAM","IEN",IEN)) Q:'IEN D
.I '$G(^DIC(4,IEN,99)) D
..S PKV="NEW"_HLCS_"STATION NUMBER"_HLCS_"D"
.I $G(^DIC(4,IEN,99)) D
..S PKV=$P(^DIC(4,IEN,99),U)_HLCS_"STATION NUMBER"_HLCS_"D"
.I CDSYS'="" D
..S $P(PKV,HLCS,1)=^TMP("XUMF MFS",$J,"PARAM","IEN",IEN)
..S $P(PKV,HLCS,2)=$P($G(^DIC(4,+IEN,0)),U),$P(PKV,HLCS,3)=CDSYS
.S ^TMP("XUMF MFS",$J,"PARAM",IEN,"PKV")=PKV
.I '$P($G(^DIC(4,+IEN,99)),U,4) D
..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",8)="1,"_IEN_","
..;S ^TMP("XUMF MFS",$J,"PARAM",IEN,"KEY","ZIN",4.014,"1,"_IEN_",")="VISN"
..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",9)="2,"_IEN_","
..;S ^TMP("XUMF MFS",$J,"PARAM",IEN,"KEY","ZIN",4.014,"2,"_IEN_",")="PARENT FACILITY"
.S RF=$$RF^XUAF4(IEN) D:RF
..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",10)=$P(RF,U,3)_","_IEN_","
..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",11)=$P(RF,U,3)_","_IEN_","
..;S ^TMP("XUMF MFS",$J,"PARAM",IEN,"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",IEN,"IENS","ZIN",12)=$P(RT,U,3)_","_IEN_","
..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",13)=$P(RT,U,3)_","_IEN_","
..;S ^TMP("XUMF MFS",$J,"PARAM",IEN,"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",IEN,"IENS","ZIN",17)=$O(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",18)=$O(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"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",IEN,"IENS","ZIN",20)=$O(^DIC(4,IEN,"TAXONOMY","B",+$P(TAX,U,2),999),-1)_","_IEN_","
..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",21)=$O(^DIC(4,IEN,"TAXONOMY","B",+$P(TAX,U,2),999),-1)_","_IEN_","
..S ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS","ZIN",22)=$O(^DIC(4,IEN,"TAXONOMY","B",+$P(TAX,U,2),999),-1)_","_IEN_","
;
Q
;
IFF(IEN) ; -- inactive facility remove VISN and parent association
;
N FDA,IENS,XUMF
;
S XUMF=1
;
S IENS="1,"_IEN_","
S FDA(4.014,IENS,.01)="@"
S IENS="2,"_IEN_","
S FDA(4.014,IENS,.01)="@"
D FILE^DIE("E","FDA")
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMFP4C 4566 printed Dec 13, 2024@02:10:57 Page 2
XUMFP4C ;CIOFO-SF/RAM - Master File C/S Params INSTITUTION ;06/28/00
+1 ;;8.0;KERNEL;**206,209,217,270,294,335,390,416**;Jul 10, 1995;Build 5
+2 ;
+3 ; this routine is a called by XUMFP4 and is a continuation of that
+4 ; routine
+5 ;
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")="Z04 "_$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(^DIC(4,+IEN,99)),U),1:"IEN ARRAY")
+33 SET $PIECE(X,HLCS,9,10)="D"_HLCS_"045A4"
+34 if $GET(CDSYS)'=""
SET $PIECE(X,HLCS,9,10)=CDSYS_HLCS_""
+35 SET ^TMP("XUMF MFS",$JOB,"PARAM","WHO")=X
End DoDot:1
+36 ;
+37 ;What Subject Filter
+38 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","WHAT"))
Begin DoDot:1
+39 SET ^TMP("XUMF MFS",$JOB,"PARAM","WHAT")="4"_HLCS_"IFN"_HLCS_"VA FM"
End DoDot:1
+40 ;
+41 ;What Department Data Code
+42 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","WDDC"))
Begin DoDot:1
+43 NEW X
SET X="INFRASTRUCTURE"_HLCS_"INFORMATION INFRASTRUCTURE"
+44 SET X=X_HLCS_"VA TS"
+45 SET ^TMP("XUMF MFS",$JOB,"PARAM","WDDC")=X
End DoDot:1
+46 ;
+47 ;What Data Code Value Qual (optional)
+48 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","WDCVQ"))
Begin DoDot:1
+49 SET ^TMP("XUMF MFS",$JOB,"PARAM","WDCVQ")=""
End DoDot:1
+50 ;
+51 ;Query Results Level (optional)
+52 IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","QRL"))
Begin DoDot:1
+53 SET ^TMP("XUMF MFS",$JOB,"PARAM","QRL")=""
End DoDot:1
+54 ;
+55 QUIT
+56 ;
PRE ; -- pre-update record
+1 ;
+2 DO PRE^XUMFR
+3 ;
+4 DO IFF(IEN)
+5 ;
+6 QUIT
+7 ;
POST ; -- post-update record
+1 ;
+2 DO POST^XUMFR
+3 ;
+4 QUIT
+5 ;
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 IF '$GET(^DIC(4,IEN,99))
Begin DoDot:2
+5 SET PKV="NEW"_HLCS_"STATION NUMBER"_HLCS_"D"
End DoDot:2
+6 IF $GET(^DIC(4,IEN,99))
Begin DoDot:2
+7 SET PKV=$PIECE(^DIC(4,IEN,99),U)_HLCS_"STATION NUMBER"_HLCS_"D"
End DoDot:2
+8 IF CDSYS'=""
Begin DoDot:2
+9 SET $PIECE(PKV,HLCS,1)=^TMP("XUMF MFS",$JOB,"PARAM","IEN",IEN)
+10 SET $PIECE(PKV,HLCS,2)=$PIECE($GET(^DIC(4,+IEN,0)),U)
SET $PIECE(PKV,HLCS,3)=CDSYS
End DoDot:2
+11 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"PKV")=PKV
+12 IF '$PIECE($GET(^DIC(4,+IEN,99)),U,4)
Begin DoDot:2
+13 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"IENS","ZIN",8)="1,"_IEN_","
+14 ;S ^TMP("XUMF MFS",$J,"PARAM",IEN,"KEY","ZIN",4.014,"1,"_IEN_",")="VISN"
+15 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"IENS","ZIN",9)="2,"_IEN_","
+16 ;S ^TMP("XUMF MFS",$J,"PARAM",IEN,"KEY","ZIN",4.014,"2,"_IEN_",")="PARENT FACILITY"
End DoDot:2
+17 SET RF=$$RF^XUAF4(IEN)
if RF
Begin DoDot:2
+18 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"IENS","ZIN",10)=$PIECE(RF,U,3)_","_IEN_","
+19 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"IENS","ZIN",11)=$PIECE(RF,U,3)_","_IEN_","
+20 ;S ^TMP("XUMF MFS",$J,"PARAM",IEN,"KEY","ZIN",4.999,$P(RF,U,3)_","_IEN_",")=$P(RF,U,3)
End DoDot:2
+21 SET RT=$$RT^XUAF4(IEN)
if RT
Begin DoDot:2
+22 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"IENS","ZIN",12)=$PIECE(RT,U,3)_","_IEN_","
+23 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"IENS","ZIN",13)=$PIECE(RT,U,3)_","_IEN_","
+24 ;S ^TMP("XUMF MFS",$J,"PARAM",IEN,"KEY","ZIN",4.999,$P(RT,U,3)_","_IEN_",")=$P(RT,U,3)
End DoDot:2
+25 SET NPI=$$NPI^XUSNPI("Organization_ID",IEN)
if NPI
Begin DoDot:2
+26 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"IENS","ZIN",17)=$ORDER(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
+27 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"IENS","ZIN",18)=$ORDER(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
+28 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"IENS","ZIN",19)=$ORDER(^DIC(4,IEN,"NPISTATUS","C",+NPI,999),-1)_","_IEN_","
End DoDot:2
+29 SET TAX=$$TAXORG^XUSTAX(IEN)
if TAX
Begin DoDot:2
+30 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"IENS","ZIN",20)=$ORDER(^DIC(4,IEN,"TAXONOMY","B",+$PIECE(TAX,U,2),999),-1)_","_IEN_","
+31 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"IENS","ZIN",21)=$ORDER(^DIC(4,IEN,"TAXONOMY","B",+$PIECE(TAX,U,2),999),-1)_","_IEN_","
+32 SET ^TMP("XUMF MFS",$JOB,"PARAM",IEN,"IENS","ZIN",22)=$ORDER(^DIC(4,IEN,"TAXONOMY","B",+$PIECE(TAX,U,2),999),-1)_","_IEN_","
End DoDot:2
End DoDot:1
+33 ;
+34 QUIT
+35 ;
IFF(IEN) ; -- inactive facility remove VISN and parent association
+1 ;
+2 NEW FDA,IENS,XUMF
+3 ;
+4 SET XUMF=1
+5 ;
+6 SET IENS="1,"_IEN_","
+7 SET FDA(4.014,IENS,.01)="@"
+8 SET IENS="2,"_IEN_","
+9 SET FDA(4.014,IENS,.01)="@"
+10 DO FILE^DIE("E","FDA")
+11 ;
+12 QUIT
+13 ;
