| 1 | IBDY337 ;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 | ;
|
|---|
| 4 | PRE ;- Create EF block list report and clear workspace before install
|
|---|
| 5 | D CLWKSP
|
|---|
| 6 | Q
|
|---|
| 7 | ;
|
|---|
| 8 | ;
|
|---|
| 9 | POST ;- Add toolkit blocks
|
|---|
| 10 | D TKBLKS
|
|---|
| 11 | D MISC
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | ;
|
|---|
| 15 | CLWKSP ;- 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 | ;
|
|---|
| 25 | TKBLKS ;- 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 | ;
|
|---|
| 66 | SUMM ;- 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 | ;
|
|---|
| 79 | TKERR ;- 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 | ;
|
|---|
| 85 | MISC ;- 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
|
|---|
