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

IBDY338.m

Go to the documentation of this file.
  1. IBDY338 ;ALB/DHH - POST INSTALL FOR PATCH IBD*3*38 ; OCT 1, 1999
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**38**;APR 24, 1997
  1. ;
  1. D ASK,ASK1
  1. ;
  1. ;-- Add CPT Modifier Tool Kit Blocks to Tool Kit
  1. D AUTOINS
  1. Q
  1. ;
  1. ASK ;-- Set ASK CPT MODIFIERS to yes for DG SELECT CPT PROCEDURE CODES
  1. ; in the package interface file
  1. ;
  1. D MES^XPDUTL(">>> Updating DG SELECT CPT PROCEDURE CODES Package Interface.")
  1. N I,J,X
  1. S I=0
  1. F S I=$O(^IBE(357.6,"B",$E("DG SELECT CPT PROCEDURE CODES",1,30),I)) Q:'I D
  1. .I $P($G(^IBE(357.6,I,0)),"^")="DG SELECT CPT PROCEDURE CODES" S $P(^IBE(357.6,I,0),"^",21)=1
  1. Q
  1. ;
  1. ASK1 ;-- Set ASK CPT MODIFIERS to yes for DG SELECT VISIT TYPE PROCEDURES
  1. ; in the package interface file
  1. ;
  1. D MES^XPDUTL(">>> Updating DG SELECT VISIT TYPE CPT PROCEDURES Package Interface.")
  1. N I,J,X
  1. S I=0
  1. F S I=$O(^IBE(357.6,"B",$E("DG SELECT VISIT TYPE CPT PROCEDURES",1,30),I)) Q:'I D
  1. .I $P($G(^IBE(357.6,I,0)),"^")="DG SELECT VISIT TYPE CPT PROCEDURES" S $P(^IBE(357.6,I,0),"^",21)=1
  1. Q
  1. ;
  1. AUTOINS ;-- Auto install CPT Modifier tool kit blocks into AICS Tool Kit
  1. N FORM,NEWFORM,FORMNM,CNT,CNT1,ARY,NAME,X,Y,NEWBLOCK,A,EXCLUDE,BLK,CNTF,CNTB
  1. D MES^XPDUTL(">>> Adding CPT Modifier Tool Kit Blocks to AICS Tool Kit.")
  1. S (CNTB,CNTF)=0
  1. ;
  1. ;-- Add all tool kit blocks
  1. S FORMNM="TOOL KIT"
  1. I '$O(^IBE(357,"B",FORMNM,0)) Q
  1. S ORD="" F S ORD=$O(^IBE(358.1,"D",ORD)) Q:ORD="" S BLK=0 F S BLK=$O(^IBE(358.1,"D",ORD,BLK)) Q:'BLK D
  1. .S NAME=$P($G(^IBE(358.1,+BLK,0)),"^")
  1. .Q:$P($G(^IBE(358.1,BLK,0)),"^",14)'=1 ;not toolkit
  1. .I $O(^IBE(357.1,"B",NAME,0)) D MES^XPDUTL(" Block "_NAME_" already exists") Q
  1. .D MES^XPDUTL(" Moving block '"_$P($G(^IBE(358.1,+BLK,0)),"^")_"' from Import/Export files to Tool Kit")
  1. .N IBTKBLK S IBTKBLK=1
  1. .S NEWBLOCK=$$COPYBLK^IBDFU2(BLK,$$TKFORM^IBDFU2C,358.1,357.1,"","",$$TKORDER^IBDF13),CNTB=CNTB+1
  1. .D:$G(NEWBLOCK) DLTBLK^IBDFU3(BLK,"",358.1)
  1. ;
  1. ;-- Clear workspace
  1. D DLTALL^IBDE2
  1. Q
  1. PREINIT ; Pre-Init for Patch 38
  1. ; clearing workspace - imp/exp
  1. D MES^XPDUTL(">>> Clearing Import/Export Workspace Now...")
  1. D DLTALL^IBDE2
  1. Q