source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDY337.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.1 KB
Line 
1IBDY337 ;ALB/DHH - PRE AND POST INSTALL FOR PATCH IBD*3*37 ; JUL 18, 2001
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**37**;APR 24, 1997
3 ;
4PRE ;- Create EF block list report and clear workspace before install
5 D CLWKSP
6 Q
7 ;
8 ;
9POST ;- Add toolkit blocks
10 D TKBLKS
11 D MISC
12 Q
13 ;
14 ;
15CLWKSP ;- Clear the AICS Import/Export Workspace (files in #358) before
16 ;- loading new toolkit blocks
17 ;
18 D MES^XPDUTL("")
19 D BMES^XPDUTL(">>> Clearing AICS Import/Export workspace...")
20 D DLTALL^IBDE2
21 D MES^XPDUTL(">>> ...completed.")
22 Q
23 ;
24 ;
25TKBLKS ;- Add GAF tool kit blocks to AICS Tool Kit
26 ;
27 N A,ARY,BLK,CNT,CNT1,CNTB,CNTF,EXCLUDE,FORM,FORMNM,NAME,IBDNM,IBDBLK,IBDX,IBTKBLK,NEWBLOCK,NEWFORM,NODE,NUM,ORD,SUMMARY,X,Y
28 ;
29 ;- Add all tool kit blocks
30 S FORMNM="TOOL KIT"
31 S (CNTB,CNTF)=0,NUM=1
32 D BMES^XPDUTL(">>> Adding GAF Tool Kit blocks to the AICS Tool Kit...")
33 ;
34 ;- Display error msg and exit if Tool Kit not found
35 I '$O(^IBE(357,"B",FORMNM,0)) D TKERR Q
36 ;
37 ;- Get blocks from Imp/Exp EF Block file
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 . ;
41 . ;- Not a tool kit block
42 . Q:$P($G(^IBE(358.1,BLK,0)),"^",14)'=1
43 . ;
44 . ;- Delete block if it already exists and is a toolkit block
45 . S IBTKBLK=1
46 . S IBDNM="" F S IBDNM=$O(^IBE(357.1,"B",IBDNM)) Q:IBDNM="" S IBDBLK=0 F S IBDBLK=+$O(^IBE(357.1,"B",IBDNM,IBDBLK)) Q:'IBDBLK D
47 .. S NODE=$G(^IBE(357.1,IBDBLK,0))
48 .. I $P((NODE),"^")=NAME,$P(NODE,"^",14) D
49 ... D DLTBLK^IBDFU3(IBDBLK,"",357.1)
50 . S NEWBLOCK=$$COPYBLK^IBDFU2(BLK,$$TKFORM^IBDFU2C,358.1,357.1,"","",$$TKORDER^IBDF13)
51 . S CNTB=CNTB+1
52 . D:$G(NEWBLOCK) DLTBLK^IBDFU3(BLK,"",358.1)
53 . ;
54 . ;- Add block name to array (used in summary at end)
55 . S SUMMARY(NUM)=NAME
56 . S NUM=NUM+1
57 . ;
58 . ;- Display msg to user
59 . D BMES^XPDUTL(">>> Moving encounter form block "_$G(NAME)_" from")
60 . D MES^XPDUTL(" AICS Import/Export files to AICS Tool Kit.")
61 ;
62 ;- Clear workspace
63 D DLTALL^IBDE2
64 D BMES^XPDUTL("... completed.")
65 ;
66SUMM ;- EF block summary displayed to user
67 D BMES^XPDUTL("Summary of Encounter Form Blocks Added to Tool Kit:")
68 D MES^XPDUTL("===================================================")
69 D MES^XPDUTL("")
70 F IBDX=0:0 S IBDX=$O(SUMMARY(IBDX)) Q:'IBDX D
71 . D MES^XPDUTL($G(SUMMARY(IBDX)))
72 I '$D(SUMMARY) D
73 . D MES^XPDUTL(">>> ERROR: Missing data in IMP/EXP ENCOUNTER FORM BLOCK file (#358.1).")
74 . D MES^XPDUTL(">>> No Encounter Form Blocks were installed. Please contact National")
75 . D MES^XPDUTL(">>> Vista Support for assistance.")
76 Q
77 ;
78 ;
79TKERR ;- Display error msg if Tool Kit not found
80 D BMES^XPDUTL(">>> ERROR: No AICS Tool Kit found. New encounter form blocks can not be")
81 D MES^XPDUTL(">>> installed. Please contact National Vista Support for assistance.")
82 Q
83 ;
84 ;
85MISC ;- Misc. manual sets that will not transport via kid
86 ;
87 ;-- add GAF SCORE HANDPRINT to HAND PRINT FIELD (359.94)
88 ;
89 K DO
90 N DIC,X
91 S DIC="^IBE(359.94,",DIC(0)="Z"
92 S X="GAF SCORE HANDPRINT"
93 S DIC("DR")=".02///GAF Score:;.03///5;.04///10;.06///GAF SCORE HANDPRINT;.08///GAF HAND PRINT V3.0;.1///GAF SCORE"
94 D FILE^DICN
95 Q
Note: See TracBrowser for help on using the repository browser.