PRC5A.m

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 ---PRC5A   1817     printed  Apr 09, 2024@21:15:04                                                                                                                                                                                                       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