PRC5B7 ;WISC/PLT-IFCAP post install routine defined in package file ;10/31/94  3:40 PM
V ;;5.0;IFCAP;**27**;4/21/95
 ;
 ;invoke by the post initial installation field of package file.
EN ;
 D EN^DDIOL("IFCAP V5 RECONVERT FND/CPF-DOCUMENT STARTS at "_$$NOW^PRC5A)
 D FND^PRC5B1 ;convert fms FND document (add fund code in file 420.3)
 ;RESET FND-DOC CONVERTED START/ENDING TIME TO BE NIL
 D
 . N PRCRI
 . S PRCRI(420.92)=""
 . F  S PRCRI(420.92)=$O(^PRCU(420.92,"B","CPF",PRCRI(420.92))) Q:'PRCRI(420.92)  S PRCA=^PRCU(420.92,PRCRI(420.92),0),$P(PRCA,"^",5,6)="^",^(0)=PRCA
 . QUIT
 D CPF^PRC5B1 ;convert fms CPF document (fill-in fms field for file 420)
 D EN^DDIOL("IFCAP V5 RECONVERT FND/CPF-DOCUMENT ENDS at "_$$NOW^PRC5A)
 QUIT
 ;
START(PRCAFC) ;restart 442 conversion with options
 ;PRCAFC=1 if mo/so only and deleting fcp yearly accounting elements
 ;      =2 if not including mo/so
 ;      =3 if mo/so only
 ;      ='ALL' if reconvert all (including mo/so)
 ;deleting fcp yearly accounting elements
 D:PRCAFC=1!(PRCAFC="ALL") FCPFY,EN^PRC5B7A
 QUIT
 ;
FCPFY ;delete all fcp fiscal yearly accounting elements
 N PRCRI,PRCY
 S PRCRI(420)=0 F  S PRCRI(420)=$O(^PRC(420,PRCRI(420))) Q:'PRCRI(420)  D
 . S PRCRI(420.01)=0
 . F  S PRCRI(420.01)=$O(^PRC(420,PRCRI(420),1,PRCRI(420.01))) Q:'PRCRI(420.01)  D
 .. S PRCFY=11
 .. F  S PRCFY=$O(^PRC(420,PRCRI(420),1,PRCRI(420.01),4,PRCFY)) Q:'PRCFY  I $D(^(PRCFY,2)) K ^(2)
 .. QUIT
 . QUIT
 QUIT
 ;
 ;
CONVALL ;convert all 442 and generate mo/so
 S PRCAFC="ALL"
 QUIT
 ;
NEWMOSO ;build mo/so and delete fcp yearly accounting elements
 S PRCAFC=1
 QUIT
 QUIT
 ;
BOC ;reconvert boc with no mo/so
 S PRCAFC=2
 QUIT
 ;
REMOSO ;rebuild mo/so only without deleting fcp yearly account elements
 S PRCAFC=3
 QUIT
 ;
SPFCP() ;checkactive supply/general post fcp accounting elements
 N PRCRI,PRCA,A
 S PRCA="" D EN^DDIOL(" ")
 S PRCRI(420)=0 F  S PRCRI(420)=$O(^PRC(420,"AD",1,PRCRI(420))) Q:'PRCRI(420)  D
 . S A=$O(^PRC(420,PRCRI(420),1,"C","GPFS FMS CONVERSION",0))
 . I A,'$D(^PRC(420,PRCRI(420),1,A,5)) S A=""
 . S PRCRI(420.01)=0 F  S PRCRI(420.01)=$O(^PRC(420,"AD",1,PRCRI(420),PRCRI(420.01))) QUIT:'PRCRI(420.01)  I '$P($G(^PRC(420,PRCRI(420),1,PRCRI(420.01),0)),"^",19),'A S PRCA="*" W PRCRI(420),"-",PRCRI(420.01),"   "
 I PRCA["*" D EN^DDIOL("The above 'station-fcp' GENERAL POST fund control points have active status and the dummy 'GPFS FMS CONVERSION' has no ACCOUNTING ELEMENTS")
 D EN^DDIOL(" ")
 S PRCRI(420)=0 F  S PRCRI(420)=$O(^PRC(420,"AD",2,PRCRI(420))) Q:'PRCRI(420)  D
 . S PRCRI(420.01)=0 F  S PRCRI(420.01)=$O(^PRC(420,"AD",2,PRCRI(420),PRCRI(420.01))) QUIT:'PRCRI(420.01)  I '$P($G(^PRC(420,PRCRI(420),1,PRCRI(420.01),0)),"^",19),'$D(^(5)) S:PRCA'["#" PRCA=PRCA_"#" W PRCRI(420),"-",PRCRI(420.01),"   "
 . I PRCA["#" D EN^DDIOL("The above 'station-fcp' SUPPLY FUND control points have active status and have  no ACCOUNTING ELEMENTS.")
 I PRCA]"" D EN^DDIOL("You must correct this before you run option 3 or 4.")
 QUIT PRCA
 ;
CEIL96 ;reset 1 to 4 qtr code sheet released? field from PRC5B
 N PRCRI,PRCA,PRCB,PRCC
 N A
 S PRCRI(420)=0 F  S PRCRI(420)=$O(^PRC(420,PRCRI(420))) QUIT:'PRCRI(420)  D
 . S PRCA=PRCRI(420)_"-"_96,PRCB=PRCA F  S PRCB=$O(^PRCF(421,"B",PRCB)) QUIT:PRCB-PRCA!'PRCB  S PRCRI(421)=$O(^(PRCB,"")) I PRCRI(421),$P(PRCB,"-",3) D:$D(^PRCF(421,PRCRI(421),0))
 .. S PRCC=^PRCF(421,PRCRI(421),0),A=$P(PRCC,"^",2),A=$P(A," ")
 .. S PRCC=$$BBFY^PRCSUT(PRCRI(420),$P(PRCB,"-",2),A,1)
 .. S $P(^PRCF(421,PRCRI(421),0),"^",23)=PRCC-1700_"0000"
 .. I $D(^PRCF(421,PRCRI(421),4)) F PRCC=1:1:4 S $P(^(4),"^",PRCC)=""
 .. QUIT
 . QUIT
 QUIT
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC5B7   3692     printed  Sep 23, 2025@19:35:59                                                                                                                                                                                                      Page 2
PRC5B7    ;WISC/PLT-IFCAP post install routine defined in package file ;10/31/94  3:40 PM
V         ;;5.0;IFCAP;**27**;4/21/95
 +1       ;
 +2       ;invoke by the post initial installation field of package file.
EN        ;
 +1        DO EN^DDIOL("IFCAP V5 RECONVERT FND/CPF-DOCUMENT STARTS at "_$$NOW^PRC5A)
 +2       ;convert fms FND document (add fund code in file 420.3)
           DO FND^PRC5B1
 +3       ;RESET FND-DOC CONVERTED START/ENDING TIME TO BE NIL
 +4        Begin DoDot:1
 +5            NEW PRCRI
 +6            SET PRCRI(420.92)=""
 +7            FOR 
                   SET PRCRI(420.92)=$ORDER(^PRCU(420.92,"B","CPF",PRCRI(420.92)))
                   if 'PRCRI(420.92)
                       QUIT 
                   SET PRCA=^PRCU(420.92,PRCRI(420.92),0)
                   SET $PIECE(PRCA,"^",5,6)="^"
                   SET ^(0)=PRCA
 +8            QUIT 
           End DoDot:1
 +9       ;convert fms CPF document (fill-in fms field for file 420)
           DO CPF^PRC5B1
 +10       DO EN^DDIOL("IFCAP V5 RECONVERT FND/CPF-DOCUMENT ENDS at "_$$NOW^PRC5A)
 +11       QUIT 
 +12      ;
START(PRCAFC) ;restart 442 conversion with options
 +1       ;PRCAFC=1 if mo/so only and deleting fcp yearly accounting elements
 +2       ;      =2 if not including mo/so
 +3       ;      =3 if mo/so only
 +4       ;      ='ALL' if reconvert all (including mo/so)
 +5       ;deleting fcp yearly accounting elements
 +6        if PRCAFC=1!(PRCAFC="ALL")
               DO FCPFY
               DO EN^PRC5B7A
 +7        QUIT 
 +8       ;
FCPFY     ;delete all fcp fiscal yearly accounting elements
 +1        NEW PRCRI,PRCY
 +2        SET PRCRI(420)=0
           FOR 
               SET PRCRI(420)=$ORDER(^PRC(420,PRCRI(420)))
               if 'PRCRI(420)
                   QUIT 
               Begin DoDot:1
 +3                SET PRCRI(420.01)=0
 +4                FOR 
                       SET PRCRI(420.01)=$ORDER(^PRC(420,PRCRI(420),1,PRCRI(420.01)))
                       if 'PRCRI(420.01)
                           QUIT 
                       Begin DoDot:2
 +5                        SET PRCFY=11
 +6                        FOR 
                               SET PRCFY=$ORDER(^PRC(420,PRCRI(420),1,PRCRI(420.01),4,PRCFY))
                               if 'PRCFY
                                   QUIT 
                               IF $DATA(^(PRCFY,2))
                                   KILL ^(2)
 +7                        QUIT 
                       End DoDot:2
 +8                QUIT 
               End DoDot:1
 +9        QUIT 
 +10      ;
 +11      ;
CONVALL   ;convert all 442 and generate mo/so
 +1        SET PRCAFC="ALL"
 +2        QUIT 
 +3       ;
NEWMOSO   ;build mo/so and delete fcp yearly accounting elements
 +1        SET PRCAFC=1
 +2        QUIT 
 +3        QUIT 
 +4       ;
BOC       ;reconvert boc with no mo/so
 +1        SET PRCAFC=2
 +2        QUIT 
 +3       ;
REMOSO    ;rebuild mo/so only without deleting fcp yearly account elements
 +1        SET PRCAFC=3
 +2        QUIT 
 +3       ;
SPFCP()   ;checkactive supply/general post fcp accounting elements
 +1        NEW PRCRI,PRCA,A
 +2        SET PRCA=""
           DO EN^DDIOL(" ")
 +3        SET PRCRI(420)=0
           FOR 
               SET PRCRI(420)=$ORDER(^PRC(420,"AD",1,PRCRI(420)))
               if 'PRCRI(420)
                   QUIT 
               Begin DoDot:1
 +4                SET A=$ORDER(^PRC(420,PRCRI(420),1,"C","GPFS FMS CONVERSION",0))
 +5                IF A
                       IF '$DATA(^PRC(420,PRCRI(420),1,A,5))
                           SET A=""
 +6                SET PRCRI(420.01)=0
                   FOR 
                       SET PRCRI(420.01)=$ORDER(^PRC(420,"AD",1,PRCRI(420),PRCRI(420.01)))
                       if 'PRCRI(420.01)
                           QUIT 
                       IF '$PIECE($GET(^PRC(420,PRCRI(420),1,PRCRI(420.01),0)),"^",19)
                           IF 'A
                               SET PRCA="*"
                               WRITE PRCRI(420),"-",PRCRI(420.01),"   "
               End DoDot:1
 +7        IF PRCA["*"
               DO EN^DDIOL("The above 'station-fcp' GENERAL POST fund control points have active status and the dummy 'GPFS FMS CONVERSION' has no ACCOUNTING ELEMENTS")
 +8        DO EN^DDIOL(" ")
 +9        SET PRCRI(420)=0
           FOR 
               SET PRCRI(420)=$ORDER(^PRC(420,"AD",2,PRCRI(420)))
               if 'PRCRI(420)
                   QUIT 
               Begin DoDot:1
 +10               SET PRCRI(420.01)=0
                   FOR 
                       SET PRCRI(420.01)=$ORDER(^PRC(420,"AD",2,PRCRI(420),PRCRI(420.01)))
                       if 'PRCRI(420.01)
                           QUIT 
                       IF '$PIECE($GET(^PRC(420,PRCRI(420),1,PRCRI(420.01),0)),"^",19)
                           IF '$DATA(^(5))
                               if PRCA'["#"
                                   SET PRCA=PRCA_"#"
                               WRITE PRCRI(420),"-",PRCRI(420.01),"   "
 +11               IF PRCA["#"
                       DO EN^DDIOL("The above 'station-fcp' SUPPLY FUND control points have active status and have  no ACCOUNTING ELEMENTS.")
               End DoDot:1
 +12       IF PRCA]""
               DO EN^DDIOL("You must correct this before you run option 3 or 4.")
 +13       QUIT PRCA
 +14      ;
CEIL96    ;reset 1 to 4 qtr code sheet released? field from PRC5B
 +1        NEW PRCRI,PRCA,PRCB,PRCC
 +2        NEW A
 +3        SET PRCRI(420)=0
           FOR 
               SET PRCRI(420)=$ORDER(^PRC(420,PRCRI(420)))
               if 'PRCRI(420)
                   QUIT 
               Begin DoDot:1
 +4                SET PRCA=PRCRI(420)_"-"_96
                   SET PRCB=PRCA
                   FOR 
                       SET PRCB=$ORDER(^PRCF(421,"B",PRCB))
                       if PRCB-PRCA!'PRCB
                           QUIT 
                       SET PRCRI(421)=$ORDER(^(PRCB,""))
                       IF PRCRI(421)
                           IF $PIECE(PRCB,"-",3)
                               if $DATA(^PRCF(421,PRCRI(421),0))
                                   Begin DoDot:2
 +5                                    SET PRCC=^PRCF(421,PRCRI(421),0)
                                       SET A=$PIECE(PRCC,"^",2)
                                       SET A=$PIECE(A," ")
 +6                                    SET PRCC=$$BBFY^PRCSUT(PRCRI(420),$PIECE(PRCB,"-",2),A,1)
 +7                                    SET $PIECE(^PRCF(421,PRCRI(421),0),"^",23)=PRCC-1700_"0000"
 +8                                    IF $DATA(^PRCF(421,PRCRI(421),4))
                                           FOR PRCC=1:1:4
                                               SET $PIECE(^(4),"^",PRCC)=""
 +9                                    QUIT 
                                   End DoDot:2
 +10               QUIT 
               End DoDot:1
 +11       QUIT