| [613] | 1 | IBDY338 ;ALB/DHH - POST INSTALL FOR PATCH IBD*3*38 ; OCT 1, 1999
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;**38**;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | D ASK,ASK1
|
|---|
| 5 | ;
|
|---|
| 6 | ;-- Add CPT Modifier Tool Kit Blocks to Tool Kit
|
|---|
| 7 | D AUTOINS
|
|---|
| 8 | Q
|
|---|
| 9 | ;
|
|---|
| 10 | ASK ;-- Set ASK CPT MODIFIERS to yes for DG SELECT CPT PROCEDURE CODES
|
|---|
| 11 | ; in the package interface file
|
|---|
| 12 | ;
|
|---|
| 13 | D MES^XPDUTL(">>> Updating DG SELECT CPT PROCEDURE CODES Package Interface.")
|
|---|
| 14 | N I,J,X
|
|---|
| 15 | S I=0
|
|---|
| 16 | F S I=$O(^IBE(357.6,"B",$E("DG SELECT CPT PROCEDURE CODES",1,30),I)) Q:'I D
|
|---|
| 17 | .I $P($G(^IBE(357.6,I,0)),"^")="DG SELECT CPT PROCEDURE CODES" S $P(^IBE(357.6,I,0),"^",21)=1
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | ASK1 ;-- Set ASK CPT MODIFIERS to yes for DG SELECT VISIT TYPE PROCEDURES
|
|---|
| 21 | ; in the package interface file
|
|---|
| 22 | ;
|
|---|
| 23 | D MES^XPDUTL(">>> Updating DG SELECT VISIT TYPE CPT PROCEDURES Package Interface.")
|
|---|
| 24 | N I,J,X
|
|---|
| 25 | S I=0
|
|---|
| 26 | F S I=$O(^IBE(357.6,"B",$E("DG SELECT VISIT TYPE CPT PROCEDURES",1,30),I)) Q:'I D
|
|---|
| 27 | .I $P($G(^IBE(357.6,I,0)),"^")="DG SELECT VISIT TYPE CPT PROCEDURES" S $P(^IBE(357.6,I,0),"^",21)=1
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | AUTOINS ;-- Auto install CPT Modifier tool kit blocks into AICS Tool Kit
|
|---|
| 31 | N FORM,NEWFORM,FORMNM,CNT,CNT1,ARY,NAME,X,Y,NEWBLOCK,A,EXCLUDE,BLK,CNTF,CNTB
|
|---|
| 32 | D MES^XPDUTL(">>> Adding CPT Modifier Tool Kit Blocks to AICS Tool Kit.")
|
|---|
| 33 | S (CNTB,CNTF)=0
|
|---|
| 34 | ;
|
|---|
| 35 | ;-- Add all tool kit blocks
|
|---|
| 36 | S FORMNM="TOOL KIT"
|
|---|
| 37 | I '$O(^IBE(357,"B",FORMNM,0)) Q
|
|---|
| 38 | 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
|
|---|
| 39 | .S NAME=$P($G(^IBE(358.1,+BLK,0)),"^")
|
|---|
| 40 | .Q:$P($G(^IBE(358.1,BLK,0)),"^",14)'=1 ;not toolkit
|
|---|
| 41 | .I $O(^IBE(357.1,"B",NAME,0)) D MES^XPDUTL(" Block "_NAME_" already exists") Q
|
|---|
| 42 | .D MES^XPDUTL(" Moving block '"_$P($G(^IBE(358.1,+BLK,0)),"^")_"' from Import/Export files to Tool Kit")
|
|---|
| 43 | .N IBTKBLK S IBTKBLK=1
|
|---|
| 44 | .S NEWBLOCK=$$COPYBLK^IBDFU2(BLK,$$TKFORM^IBDFU2C,358.1,357.1,"","",$$TKORDER^IBDF13),CNTB=CNTB+1
|
|---|
| 45 | .D:$G(NEWBLOCK) DLTBLK^IBDFU3(BLK,"",358.1)
|
|---|
| 46 | ;
|
|---|
| 47 | ;-- Clear workspace
|
|---|
| 48 | D DLTALL^IBDE2
|
|---|
| 49 | Q
|
|---|
| 50 | PREINIT ; Pre-Init for Patch 38
|
|---|
| 51 | ; clearing workspace - imp/exp
|
|---|
| 52 | D MES^XPDUTL(">>> Clearing Import/Export Workspace Now...")
|
|---|
| 53 | D DLTALL^IBDE2
|
|---|
| 54 | Q
|
|---|
