- 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 Jan 18, 2025@03:00:59 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