Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUMF04P

XUMF04P.m

Go to the documentation of this file.
  1. XUMF04P ;BP/RAM - INSTITUTION CLEANUP ;06/28/00
  1. ;;8.0;KERNEL;**549**;Jul 10, 1995;Build 12
  1. ;
  1. ;
  1. Q
  1. ;
  1. MAIN ; -- post init entry point
  1. ;
  1. Q:$$KSP^XUPARAM("INST")=12000
  1. Q:$P($$PARAM^HLCS2,U,3)="T"
  1. ;
  1. M ^TMP("XUMF 04",$$NOW^XLFDT,$J,4)=^DIC(4)
  1. ;
  1. S XUMF=1
  1. ;
  1. D P101,PHARM,LP1,LP2,NPI,TAX,EN^XUMF04Q,BK
  1. ;
  1. Q
  1. ;
  1. KT ; -- kill temp node / file backup
  1. ;
  1. K ^TMP("XUMF 04")
  1. ;
  1. Q
  1. ;
  1. BK ; -- background job to kill temp node in 30 days
  1. ;
  1. N ZTRTN,ZTDESC,ZTDTH
  1. ;
  1. S ZTRTN="KT^XUMF04P"
  1. S ZTDESC="XUMF kill temp backup of file 4 - patch xu549"
  1. S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,30,0,0,0)
  1. S ZTIO=""
  1. ;
  1. D ^%ZTLOAD
  1. ;
  1. Q
  1. ;
  1. P101 ; -- add subscriber protocols to event protocols
  1. ;
  1. N IEN,FDA,IENS
  1. ;
  1. ; mfp
  1. K FDA
  1. S IEN=$$FIND1^DIC(101,,"B","XUMF 04 MFQ")
  1. S IENS=IEN_","
  1. S FDA(101.0775,"?+1,"_IENS,.01)="XUMF 04 MFR"
  1. D UPDATE^DIE("E","FDA","IENS")
  1. ;
  1. ; mfq
  1. K FDA
  1. S IEN=$$FIND1^DIC(101,,"B","XUMF 04 MFN")
  1. S IENS=IEN_","
  1. S FDA(101.0775,"?+1,"_IENS,.01)="XUMF 04 MFK"
  1. D UPDATE^DIE("E","FDA","IENS")
  1. ;
  1. Q
  1. ;
  1. LP1 ; -- loop file
  1. ;
  1. W !!!,"CHECKING IDENTIFIER MULTIPLE",!!!
  1. ;
  1. N IEN,STA,IEN,DA
  1. ;
  1. S STA="" F S STA=$O(^DIC(4,"XUMFIDX","VASTANUM",STA)) Q:STA="" D
  1. . S IEN=$O(^DIC(4,"XUMFIDX","VASTANUM",STA,0)) Q:'IEN
  1. . S DA=$O(^DIC(4,"XUMFIDX","VASTANUM",STA,IEN,0)) Q:'DA
  1. . D CLN
  1. ;
  1. Q
  1. ;
  1. LP2 ; -- loop file
  1. ;
  1. N IEN,NPI,IEN,DA
  1. ;
  1. S NPI="" F S NPI=$O(^DIC(4,"XUMFIDX","NPI",NPI)) Q:NPI="" D
  1. . S IEN=$O(^DIC(4,"XUMFIDX","NPI",NPI,0)) Q:'IEN
  1. . S DA=$O(^DIC(4,"XUMFIDX","NPI",NPI,IEN,0)) Q:'DA
  1. . D CLN
  1. ;
  1. Q
  1. ;
  1. CLN ; -- clean up id mult
  1. ;
  1. N IENS,ROOT,DIK,DIC
  1. ;
  1. S IENS=IEN_","
  1. ;
  1. S ROOT=$$ROOT^DILFD(4.9999,","_IENS,1)
  1. S DA(1)=+IENS,DIK=$P(ROOT,")")_"," D ^DIK
  1. ;
  1. Q
  1. ;
  1. NPI ; -- clean npi
  1. ;
  1. N IEN,NPI,IEN,ROOT,IENS
  1. ;
  1. S IEN=0 F S IEN=$O(^DIC(4,IEN)) Q:'IEN D
  1. . S NPI=$G(^DIC(4,IEN,"NPI")) Q:'NPI
  1. . S IDX=0 F S IDX=$O(^DIC(4,IEN,"NPISTATUS",IDX)) Q:'IDX D
  1. .. Q:$P(^DIC(4,IEN,"NPISTATUS",IDX,0),U,3)=NPI
  1. .. S IENS=IEN_",",ROOT=$$ROOT^DILFD(4.042,","_IENS,1)
  1. .. N DA,DIK,DIC S DA(1)=+IENS,DA=IDX,DIK=$P(ROOT,")")_"," D ^DIK
  1. ;
  1. Q
  1. ;
  1. PHARM ; REMOVE DUPLICATE PHARM
  1. ;
  1. W !!!,"CLEANING UP DUPLICATE PHARMACY ENTRIES",!!!
  1. ;
  1. N NAME,IEN,IENS,FDA,XUMF
  1. ;
  1. S NAME=""
  1. F S NAME=$O(^DIC(4,"B",NAME)) Q:NAME="" Q:$E(NAME,1,2)="ZZ" D
  1. .Q:NAME'[" PHARM"
  1. .S IEN=0 F S IEN=$O(^DIC(4,"B",NAME,IEN)) Q:'IEN D
  1. ..Q:+$G(^DIC(4,IEN,"NPI"))
  1. ..Q:+$G(^DIC(4,IEN,99))
  1. ..Q:$P($G(^DIC(4,IEN,0)),U,11)="L"
  1. ..S XUMF=1
  1. ..S IENS=IEN_","
  1. ..K FDA
  1. ..S FDA(4,IENS,.01)=$E("ZZ DUP "_NAME,1,30)
  1. ..S FDA(4,IENS,101)="INACTIVE"
  1. ..D FILE^DIE("E","FDA")
  1. ;
  1. Q
  1. ;
  1. TAX ;
  1. ;
  1. S IEN=0 F S IEN=$O(^DIC(4,IEN)) Q:'IEN D
  1. .Q:'$D(^DIC(4,IEN,"TAXONOMY"))
  1. .N ROOT,IDX,IENS
  1. .S IENS=IEN_",",ROOT=$$ROOT^DILFD(4.043,","_IENS,1)
  1. .S IDX=$O(@ROOT@(0)) Q:'IDX
  1. .F S IDX=$O(@ROOT@(IDX)) Q:'IDX D
  1. ..D
  1. ...N DA,DIK,DIC S DA(1)=+IENS,DA=IDX,DIK=$P(ROOT,")")_"," D ^DIK
  1. ;
  1. Q
  1. ;
  1. EXIT ; -- cleanup, and quit
  1. ;
  1. Q
  1. ;