| 1 | PRC5A ;WISC/PLT-IFCAP pre-install routine defined in package file ;9/13/00 17:46
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;invoke by the pre-initial installation field of package file.
|
|---|
| 5 | EN ;called from routine prcinit[1]
|
|---|
| 6 | D EN^DDIOL("IFCAP PRE-INIT STARTS at "_$$NOW)
|
|---|
| 7 | D DESCRIP^PRC5INS1(410,443.99) ;remove ifcap dd field descriptions
|
|---|
| 8 | ;remove erroneous computed field nodes of Free-Text field
|
|---|
| 9 | K ^DD(420.01,2,9.01),^(9.1),^(9.2)
|
|---|
| 10 | K ^DD(420.01,3,9.01),^(9.1),^(9.2)
|
|---|
| 11 | ;Delete discontinued fields
|
|---|
| 12 | S DIK="^DD(443.6,",DA(1)=443.6 F DA=.4,8.4 D:$D(^DD(443.6,DA)) ^DIK
|
|---|
| 13 | K DA,DIK
|
|---|
| 14 | ;kill erroneous index nodes
|
|---|
| 15 | K ^DD(442.8,0,"IX","AE",442.8,.01)
|
|---|
| 16 | ;kill old "NM" nodes where name change
|
|---|
| 17 | K ^DD(420.11,0,"NM","SUBACCOUNT")
|
|---|
| 18 | F X="PRCO EDI RE-TRAN^PRCHPC PO","PRCHPM CS RETRANSMIT BATCH^PRCHPM CS TRANSMISSION MENU" D UNLINK($P(X,"^"),$P(X,"^",2))
|
|---|
| 19 | D ^PRCIPR1A ;delete option/routine/template(s)
|
|---|
| 20 | D EN3^PRC5C1 ;reindex special fcp in file 420
|
|---|
| 21 | ;add entry in file 420.92 if not defined
|
|---|
| 22 | I '$O(^PRCU(420.92,"B",PRCFIXV,"")) D
|
|---|
| 23 | . N PRCRI,A
|
|---|
| 24 | . S A="",PRCRI(9.4)=$O(^DIC(9.4,"B","IFCAP",0)) I PRCRI(9.4) S A=$P(^DIC(9.4,PRCRI(9.4),"VERSION"),"^",1)
|
|---|
| 25 | . S A=A_"/"_$P($T(+2^PRCINIT),";",3)
|
|---|
| 26 | . S X=PRCFIXV,X("DR")="1////"_A_";2.6///^S X=""N"""
|
|---|
| 27 | . D ADD^PRC0B1(.X,.Y,"420.92;^PRCU(420.92,")
|
|---|
| 28 | . I Y=-1 K Y I Y W !,"ERROR TRAP! CALL IRM/ISC SUPPORT."
|
|---|
| 29 | . QUIT
|
|---|
| 30 | D EN^DDIOL("IFCAP PRE-INIT ENDS at"_$$NOW)
|
|---|
| 31 | QUIT
|
|---|
| 32 | ;
|
|---|
| 33 | ;
|
|---|
| 34 | NOW() ;ev value date@time of now
|
|---|
| 35 | N %H,Y,X,%
|
|---|
| 36 | S %H=$H D YX^%DTC
|
|---|
| 37 | QUIT Y
|
|---|
| 38 | ;
|
|---|
| 39 | UNLINK(A,B) ;Remove Option from Menu
|
|---|
| 40 | ;A: Option to remove; B: Menu
|
|---|
| 41 | N X,DA
|
|---|
| 42 | S X=$O(^DIC(19,"B",A,0)) Q:X'?1.N
|
|---|
| 43 | S DA(1)=$O(^DIC(19,"B",B,0)) Q:DA(1)'?1.N
|
|---|
| 44 | S DA=$O(^DIC(19,DA(1),10,"B",X,0)) Q:DA'?1.N
|
|---|
| 45 | S DIK="^DIC(19,"_DA(1)_",10," D ^DIK K DIK
|
|---|
| 46 | Q
|
|---|
