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