XUMF ;OIFO-OAK/RAM - XUMF API's;04/15/02
 ;;8.0;KERNEL;**218,335,416**;Jul 10, 1995;Build 5
 ;
 Q
 ;
IEN(IFN,CDSYS,ID) ; -- Internal Entry Number
 ;
 N IEN,ROOT
 ;
 S IFN=$G(IFN),CDSYS=$G(CDSYS),ID=$G(ID)
 ;
 Q:'IFN "0^IFN required"
 Q:CDSYS="" "0^CDSYS required"
 Q:ID="" "0^ID required"
 ;
 S ROOT=$$ROOT^DILFD(IFN,,1) Q:ROOT="" "0^invalid IFN"
 S IEN=$O(@ROOT@("XUMFIDX",CDSYS,ID,0))
 ;
 Q $S(IEN:IEN,1:"0^not found")
 ;
FLD(FILE,FIELD) ; field
 ;
 N Y,DA,X
 ;
 S Y=$$FIELD(FILE,FIELD,"LABEL")
 ;
 Q $S(Y'="":1,1:0)
 ;
LBL(FILE,FIELD) ; field label
 ;
 Q $$FIELD(FILE,FIELD,"LABEL")
 ;
TYP(FILE,FIELD) ; field type
 ;
 Q $$FIELD(FILE,FIELD,"TYPE")
 ;
PTR(FILE,FIELD) ; pointer field?
 ;
 Q $S($$TYP(FILE,FIELD)="POINTER":1,1:0)
 ;
FIELD(FILE,FIELD,ATT) ; field attributes
 ;
 N Y,DA,X
 ;
 Q:'$G(FILE) ""
 Q:'$G(FIELD) ""
 Q:$G(ATT)="" ""
 ;
 D FIELD^DID(FILE,FIELD,"N",ATT,"Y")
 ;
 Q $G(Y(ATT))
 ;
FILE(FILE,ATT) ; file attributes
 ;
 N Y,DA,X
 ;
 Q:'$G(FILE) ""
 Q:$G(ATT)="" ""
 ;
 D FILE^DID(FILE,,ATT,"Y")
 ;
 Q $G(Y(ATT))
 ;
ECHO(FILE,IDX,X,XUMF) ; validate field exists and echo name
 ;
 Q:'$$F(+$G(XUMF)) 0
 ;
 N SUBFILE,NAME
 ;
 S SUBFILE=$P($G(^DIC(4.001,+$G(FILE),1,+$G(IDX),0)),U,4)
 ;
 S NAME=$$LBL($S(SUBFILE:SUBFILE,1:+$G(FILE)),X)
 ;
 Q:NAME="" 0
 ;
 ;W " "_NAME
 ;
 Q 1
 ;
F(XUMF) ; constrain edits to standard values
 ;
 Q $S($G(XUMF):1,1:0)
 ;
PKV(IFN,IEN,HLCS) ; Primary Key Value - MFE.4
 ;
 S IFN=$G(IFN),IEN=$G(IEN),HLCS=$G(HLCS)
 ;
 N MFE,NODE,ID,TEXT,CDSYS,IENS
 ;
 S NODE=$G(^DIC(4.001,IFN,"MFE"))
 Q:NODE="" "1Error - MFS parameter not defined for IFN "_IFN
 ;
 S:HLCS="" HLCS="~"
 S CDSYS=$P(NODE,U,3)
 ;
 Q:IEN="NEW" IEN_HLCS_"NEW ENTRY"_HLCS_CDSYS
 ;
 Q:'IFN "1Error - IFN required"
 Q:'IEN "1Error - IEN required"
 ;
 S IENS=IEN_","
 ;
 S FIELD=$P(NODE,U,1),ID=$$GET1^DIQ(IFN,IENS,FIELD)
 S FIELD=$P(NODE,U,2),TEXT=$$GET1^DIQ(IFN,IENS,FIELD)
 ;
 S MFE=ID_HLCS_TEXT_HLCS_CDSYS
 ;
 Q:'$P(NODE,U,4) MFE
 ;
 S FIELD=$P(NODE,U,4),ID=$$GET1^DIQ(IFN,IENS,FIELD)
 S FIELD=$P(NODE,U,5),TEXT=$$GET1^DIQ(IFN,IENS,FIELD)
 S CDSYS=$P(NODE,U,6)
 ;
 Q MFE_HLCS_ID_HLCS_TEXT_HLCS_CDSYS
 ;
MFE(IFN,PKV,HLCS,IEN,ERROR) ; -- update
 ;
 N IENS,MFE,I,X,ID,XREF,NAME,FLD,FDA,DIC
 ;
 S IFN=$G(IFN),IEN=$G(IEN),HLCS=$G(HLCS),ERROR=$G(ERROR)
 S:HLCS="" HLCS="~"
 ;
 Q:ERROR
 ;
 I 'IFN S ERROR="1Error - IFN required" Q
 ;
 I IFN'=4.001 D  Q:ERROR
 .S MFE=$G(^DIC(4.001,IFN,"MFE")),XREF=$P(MFE,U,8)
 .I '$P(MFE,U,1) D  Q
 ..S ERROR="1MFS PARAM MFE.4.1 null"
 ..D EM^XUMFH(ERROR,.ERR)
 .I '$P(MFE,U,2) D  Q
 ..S ERROR="1MFS PARAM MFE.4.2 null"
 ..D EM^XUMFH(ERROR,.ERR)
 .I XREF="" D  Q
 ..S ERROR="1MFS PARAM MFE XREF not defined"
 ..D EM^XUMFH(ERROR,.ERR)
 ;
 I IFN=4.001 D  Q
 .S IEN=$$FIND1^DIC(1,,"BX",$P(PKV,HLCS))
 .I 'IEN D  Q
 ..S ERROR="1not a valid IEN in MFE XUMF"
 ..D EM^XUMFH(ERROR,.ERR)
 .Q:$D(^DIC(4.001,IEN))
 .X HLNEXT
 .I $P(HLNODE,HLFS)'="ZZZ" D  Q
 ..S ERROR="1MFP error in MFE XUMF"
 ..D EM^XUMFH(ERROR,.ERR)
 .S MFE=$P(HLNODE,HLFS,7,12),MFE=$TR(MFE,HLFS,U)
 .S X="" F I=5,4,2,1 S:$P(MFE,U,I)=.01 X=I
 .I 'X D  Q
 ..S ERROR="1MFS PARAM no .01 in MFE"
 ..D EM^XUMFH(ERROR,.ERR)
 .S NAME=$P(PKV,HLCS,X) K X
 .K FDA
 .S FDA(IFN,"?+1,",.01)=NAME
 .D UPDATE^DIE("E","FDA")
 ;
 S ID=$P(PKV,HLCS)
 I ID="" D  Q
 .S ERROR="1MFS PARAM MFE PKV ID null"
 .D EM^XUMFH(ERROR,.ERR)
 S ROOT=$$ROOT^DILFD(IFN,,1)
 I $D(@ROOT@(XREF)),'$G(IEN) S IEN=$O(@ROOT@(XREF,ID,0))
 S:'IEN IEN=$$FIND1^DIC(IFN,,"B",ID)
 ;
 I 'IEN D  Q:ERROR
 .S X="" F I=5,4,2,1 S:$P(MFE,U,I)=.01 X=I
 .I 'X D  Q
 ..S ERROR="1MFS PARAM no .01 in MFE"
 ..D EM^XUMFH(ERROR,.ERR)
 .S NAME=$P(PKV,HLCS,X) K X
 .I NAME="" S ERROR="1MFS PARAM MFE PKV .01 is null" Q
 .D CHK^DIE(IFN,.01,,NAME,.X)
 .I X="^" D  Q
 ..S ERROR="1MFS PARAM MFE PKV .01 is invalid"
 ..D EM^XUMFH(ERROR,.ERR)
 .K DIC S DIC=IFN,DIC(0)="F" D FILE^DICN K DIC
 .I Y="-1" D  Q
 ..S ERROR="1MFS PARAM MFE FileDICN unsuccessful"
 ..D EM^XUMFH(ERROR,.ERR)
 .S IEN=+Y
 ;
 S IENS=IEN_","
 ;
 F I=1,2,4,5 D
 .S FLD=$P(MFE,U,I) Q:'FLD
 .S FDA(IFN,IENS,FLD)=$P(PKV,HLCS,I)
 ;
 D FILE^DIE("E","FDA","ERR")
 I $D(ERR) D
 .D EM^XUMFH("1FILE DIE error msg in MFE of XUMF",.ERR)
 .K ERR
 ;
 Q
 ;
MFP(IFN,ERR) ; -- validate Master File Parameters entry FALSE=valid
 ;
 Q:'$G(IFN) "IFN null"
 ;
 D ZERO(IFN,.ERR)
 D MFE1(IFN,.ERR)
 D SEQ(IFN,.ERR)
 ;
 Q $S($D(ERR("FATAL")):1,$D(ERR("WARNING")):2,1:0)
 ;
ZERO(IFN,ERR) ; -- zero node
 ;
 N X,CNT
 ;
 S X=$G(^DIC(4.001,+IFN,0)),CNT=1
 I $P(X,U,2)="" D
 .S ERR("FATAL","ZERO",CNT)="Z SEGMENT is null",CNT=CNT+1
 I $P(X,U,3)="" D
 .S ERR("FATAL","ZERO",CNT)="MFI CODE is null",CNT=CNT+1
 I $P(X,U,4)="" D
 .S ERR("WARNING","ZERO",CNT)="PRE-UPDATE ROUTINE is null",CNT=CNT+1
 I $P(X,U,5)="" D
 .S ERR("WARNING","ZERO",CNT)="POST-UPDATE ROUTINE is null",CNT=CNT+1
 I $P(X,U,6)="" D
 .S ERR("WARNING","ZERO",CNT)="MAIL GROUP is null",CNT=CNT+1
 ;
 Q
 ;
MFE1(IFN,ERR) ; -- MFE node
 ;
 N X,I,CNT
 ;
 S X=$G(^DIC(4.001,+IFN,"MFE")),CNT=1
 F I=1:1:6 I $P(X,U,I)="" D
 .S ERR("FATAL","MFE",CNT)="MFE ID & ALT ID field and codsys required"
 .S CNT=CNT+1
 I $P(X,U,8)="" D
 .S ERR("FATAL","MFE",CNT)="MFE PKV X-REF required",CNT=CNT+1
 F I=11,12,14,15 I $P(X,U,I)="" D
 .S ERR("WARNING","MFE",CNT)="MFE PKV types are null",CNT=CNT+1
 I $P(X,U,9)="" D
 .S ERR("WARNING","MFE",CNT)="ASSIGNING AUTHORITY is null",CNT=CNT+1
 ;
 Q
 ;
SEQ(IFN,ERR) ; -- sequence nodes
 ;
 N SEQ,MULT,X,I,Y
 ;
 S SEQ=0
 F  S SEQ=$O(^DIC(4.001,IFN,1,SEQ)) Q:'SEQ  D
 .S X=$G(^DIC(4.001,IFN,1,SEQ,0))
 .I $$TYP($S($P(X,U,4):$P(X,U,4),1:IFN),$P(X,U,2))="POINTER" D
 ..Q:$P(X,U,7)'=""
 ..S Y=$S($P(X,U,4):$P(X,U,4),1:IFN),Y=$$LBL(Y,$P(X,U,2))
 ..S Y="field "_Y_" is pointer EXTENDED POINTER LKUP is NULL"
 ..S ERR("WARNING",SEQ)=Y
 .S MULT=$S($P(X,U,4):1,1:0)
 .I '$P(X,U,2) S ERR("FATAL",SEQ)=" missing FIELD NUMBER"
 .I MULT,$P(X,U,8)="" D
 ..S ERR("FATAL",SEQ)=" MULT IEN FUNCTION is null"
 .I MULT,$P(X,U,6),$P(X,U,5)'="" D
 ..S ERR("FATAL",SEQ)=" SUBFILE KEY LKUP/KEY SEQ mismatch"
 .I MULT,'$P(X,U,6),$P(X,U,5)="" D
 ..S ERR("FATAL",SEQ)=" SUBFILE KEY LKUP/KEY SEQ mismatch"
 .I 'MULT F I=5,6,8 D
 ..Q:$P(X,U,I)=""
 ..S ERR("FATAL",SEQ)=" SUBFILE null with subfile parameters"
 ;
 Q
 ;
BG(IFN,IEN,TYP) ; -- background job
 ;
 ; type (5=file, 7=array)
 ;
 N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
 ;
 S TYP=$G(TYP) S:'TYP TYP=5
 S IEN=$G(IEN) S:IEN="" IEN="ALL"
 ;
 S ZTDTH=$$NOW^XLFDT,ZTRTN="BG1^XUMF",ZTIO=""
 S ZTSAVE("IFN")="",ZTSAVE("TYP")="",ZTSAVE("IEN")=""
 S ZTDESC="XUMF get "_$$FILE^XUMF(IFN,"NAME")_" using MFS"
 ;
 D ^%ZTLOAD
 ;
 Q
 ;
BG1 ; -- get file
 ;
 D MFS(IFN,IEN,TYP,.ERROR),EXIT
 ;
 Q
 ;
LOAD(IFN) ; -- query and file
 ;
 D MFS(IFN,"ALL",5,.ERROR)
 ;
 Q
 ;
ARRAY(IFN) ; -- query and put in array
 ;
 D MFS(IFN,"ALL",7,.ERROR)
 ;
 Q
 ;
GETCE(IFN,IEN,TYP,ERROR) ; -- get master file provide coded element
 ;
 Q
 ;
MFS(IFN,IEN,TYP,ERROR) ; -- get file from Master File Server
 ;
 ; TYP (5=query/file, 7=query/tmp_array)
 ;
 N TEST
 ;
 S (ERROR,TEST)=0
 ;
 S IFN=$G(IFN),IEN=$G(IEN),TYP=$G(TYP)
 ;
 I 'IFN S ERROR="1IFN not valid MFS in XUMF" Q
 I IEN="" S ERROR="1IEN not valid MFS in XUMF" Q
 I TYP'=5,TYP'=7 S ERROR="1type not support by MFS in XUMF" Q
 ;
 I $P($$PARAM^HLCS2,U,3)="T" S TEST=1
 ;
 S PARAM("LLNK")="XUMF MFR^XUMF "_$S('TEST:"FORUM",1:"TEST")
 S PARAM("PROTOCOL")=$O(^ORD(101,"B","XUMF MFQ",0))
 ;
 D MAIN^XUMFP(IFN,"ALL",TYP,.PARAM,.ERROR) Q:ERROR
 D MAIN^XUMFI(IFN,"ALL",TYP,.PARAM,.ERROR) Q:ERROR
 D MAIN^XUMFH
 ;
 Q
 ;
 ;
EXIT ; -- cleanup and quit
 ;
 K ^TMP("XUMF MFS",$J),^TMP("DIERR",$J)
 ;
 S ZTREQ="@"
 ;
 Q
 ;
NPI ; -- NPI
 ;
 N COL,X,FDA,NPIDT,NPISTAT,NPI,TAX,TAXPC,TAXSTAT,ERR
 ;
 D SEGPRSE^XUMFXHL7("HLNODE","COL")
 ;
 S NPIDT=$$FMDATE^HLFNC(COL(17))
 S NPISTAT=COL(18)
 S NPI=COL(19)
 S TAX=COL(20)
 S TAXPC=COL(21)
 S TAXSTAT=COL(22)
 ;
 S X=$$NPI^XUSNPI("Organization_ID",IEN,NPIDT)
 I $S(X=0:1,$$UP^XLFSTR($P(X,U,3))'=NPISTAT:1,NPI'=+X:1,1:0) D
 .S X=$$ADDNPI^XUSNPI("Organization_ID",IEN,NPI,NPIDT,$S(NPISTAT="ACTIVE":1,1:0))
 ;
 S IENS="?+1,"_IEN_","
 K FDA
 S FDA(4.9999,IENS,.01)="NPI"
 S FDA(4.9999,IENS,.02)=NPI
 D UPDATE^DIE("E","FDA",,"ERR")
 ;
 K FDA
 S IENS="?+1,"_IEN_","
 S FDA(4.043,IENS,.01)=TAX
 S FDA(4.043,IENS,.02)=TAXPC
 S FDA(4.043,IENS,.03)=TAXSTAT
 D UPDATE^DIE("E","FDA",,"ERR")
 ;
 S SEQ=22
 ;
 Q
 ;
CDSYS(CDSYS,ID,IEN) ; udpate coding system / ID
 ;
 N IENS,FDA
 ;
 S IENS="?+1,"_IEN_","
 K FDA
 S FDA(4.9999,IENS,.01)=CDSYS
 S FDA(4.9999,IENS,.02)=ID
 D
 .N IEN,VALUE
 .D UPDATE^DIE("E","FDA")
 ;
 Q
 ;