- PRCFOOR4 ;WISC/CTB,AKS - 850 UTILITIES ;12/15/94 12:00 PM
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- REMOVE(DA) ;REMOVE MESSAGE FROM 423.6
- D KILL^PRCOSRV3(DA)
- QUIT
- FCPBULL(PRCDA) ;FIRE BULLETIN THAT CCP MESSAGE HAS BEEN COMPLETED
- S XMB(1)=PRCDA,XMB="PRCF FMS ADJUSTMENTS",XMDUZ=.5,XMY(DUZ)=""
- D EN^XMB QUIT
- BULL(PRCDA) ;FIRE BULLETIN THAT OOP MESSAGE HAS BEEN COMPLETED SUCCESSFULLY.
- S XMB(1)=PRCDA,XMB="PRCF_850_BULLETIN",XMDUZ=.5,XMY(DUZ)=""
- D EN^XMB
- Q
- BULL1(PRCDA,X) ;FIRE BULLETIN THAT OOP MESSAGE ENCOUNTERED AN ERROR IN PROCESSING.
- ;PARAMATERS ARE: PRCDA=MSG NUMBER IN 423.6 WHICH FAILED, X=MESSAGE TEXT
- S XMB(1)=PRCDA,XMB="PRCF_850_BULLETIN1",XMDUZ=.5,XMY(DUZ)=""
- S X=" "_X,A(1)=X,XMTEXT="A("
- D EN^XMB
- QUIT
- PRINT ;PRINT REPORT OF OUTSTANDING OBLIGATION REPORT - FILE 420.96
- D ^PRCFSITE Q:'%
- W ! K IO("Q"),PRCOSTAT S %ZIS("B")="HOME",%ZIS="QM" D ^%ZIS Q:POP
- I $D(IO("Q")) S ZTDTH="",ZTIO=IO D Q
- .S ZTDESC="OUTSTANDING OBLIGATION REPORT"
- .S ZTRTN="RPT^PRCFOOR4",ZTSAVE("PRC*")=""
- .D ^%ZTLOAD
- RPT ;
- S (PRCFAT,PRCFAS,PRCFCT,PRCFCS,PRCFOT,PRCFOS)=0
- S DIC="^PRCU(420.96,",FLDS="[PRCFOOR4]",BY="[PRCFOOR4]" S:$D(ION) IOP=ION
- S FR=PRC("SITE"),TO=PRC("SITE"),DIOEND="D B^PRCFOOR5",DHD="OUTSTANDING OBLIGATION REPORT"
- D EN1^DIP
- QUIT
- PRINT2 ;PRINT REPORT OF ERRORS ON FCP CONVERSION - FILE 420.98
- QUIT
- RESTART ;OPTION ENTRY POINT TO RESTART FAILED OUTSTANDING OBLIGATION REPORT
- ;ASK FOR MESSAGE NUMBER IN 423.6
- ;ASK FOR DEVICE
- ;SET VARIABLE PRCDA=INTERNAL REFERENCE NUMBER IN 423.6
- S DIC="^PRCF(423.6,",DIC(0)="AEQ" D ^DIC Q:Y<0
- S PRCDA=+Y
- ;W ! K IO("Q") S %ZIS("B")="HOME",%ZIS="QM" D ^%ZIS Q:POP
- ;I $D(IO("Q")) S ZTDTH="",ZTIO=IO D
- ;.S ZTDESC="OUTSTANDING OBLIGATION REPORT"
- ;.S ZTRTN="^PRCFOOR3",ZTSAVE("PRC*")=""
- ;.S ZTIO="" D ^%ZTLOAD
- S ZTDESC="OUTSTANDING OBLIGATION REPORT"
- S ZTRTN="^PRCFOOR3",ZTSAVE("PRC*")=""
- S ZTIO="" D ^%ZTLOAD
- QUIT
- ;D ^PRCFOOR3
- ;D ^%ZISC
- QUIT
- RESTART1 ;OPTION ENTRY POINT TO RESTART FAILED FCP CONVERSION
- ;ASK FOR MESSAGE NUMBER IN 423.6
- ;SET VARIABLE PRCDA=INTERNAL REFERENCE NUMBER IN 423.6
- ;ASK FOR DEVICE
- S DIC="^PRCF(423.6,",DIC(0)="AEQ" D ^DIC Q:Y<0
- S PRCDA=+Y
- W ! K IO("Q") S %ZIS("B")="HOME",%ZIS="QM" D ^%ZIS Q:POP
- I $D(IO("Q")) S ZTDTH="",ZTIO=IO D
- .S ZTDESC="FUND CONTROL POINT CONVERSION"
- .S ZTRTN="^PRCFOOR2",ZTSAVE("PRC*")=""
- .D ^%ZTLOAD
- D ^PRCFOOR2
- D ^%ZISC
- QUIT
- CLEAN(SITE) ;REMOVE ALL RECORDS FROM FILE 420.96 WITH STATION NUMBER (SITE)
- N N,DA,DIK
- S DIK="^PRCU(420.96,"
- S DA=0 F S DA=$O(^PRCU(420.96,DA)) Q:'DA S X=$P(^(DA,0),"^",8) I X=""!(X=SITE) D ^DIK
- QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFOOR4 2691 printed Jan 18, 2025@03:05:23 Page 2
- PRCFOOR4 ;WISC/CTB,AKS - 850 UTILITIES ;12/15/94 12:00 PM
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- REMOVE(DA) ;REMOVE MESSAGE FROM 423.6
- +1 DO KILL^PRCOSRV3(DA)
- +2 QUIT
- FCPBULL(PRCDA) ;FIRE BULLETIN THAT CCP MESSAGE HAS BEEN COMPLETED
- +1 SET XMB(1)=PRCDA
- SET XMB="PRCF FMS ADJUSTMENTS"
- SET XMDUZ=.5
- SET XMY(DUZ)=""
- +2 DO EN^XMB
- QUIT
- BULL(PRCDA) ;FIRE BULLETIN THAT OOP MESSAGE HAS BEEN COMPLETED SUCCESSFULLY.
- +1 SET XMB(1)=PRCDA
- SET XMB="PRCF_850_BULLETIN"
- SET XMDUZ=.5
- SET XMY(DUZ)=""
- +2 DO EN^XMB
- +3 QUIT
- BULL1(PRCDA,X) ;FIRE BULLETIN THAT OOP MESSAGE ENCOUNTERED AN ERROR IN PROCESSING.
- +1 ;PARAMATERS ARE: PRCDA=MSG NUMBER IN 423.6 WHICH FAILED, X=MESSAGE TEXT
- +2 SET XMB(1)=PRCDA
- SET XMB="PRCF_850_BULLETIN1"
- SET XMDUZ=.5
- SET XMY(DUZ)=""
- +3 SET X=" "_X
- SET A(1)=X
- SET XMTEXT="A("
- +4 DO EN^XMB
- +5 QUIT
- PRINT ;PRINT REPORT OF OUTSTANDING OBLIGATION REPORT - FILE 420.96
- +1 DO ^PRCFSITE
- if '%
- QUIT
- +2 WRITE !
- KILL IO("Q"),PRCOSTAT
- SET %ZIS("B")="HOME"
- SET %ZIS="QM"
- DO ^%ZIS
- if POP
- QUIT
- +3 IF $DATA(IO("Q"))
- SET ZTDTH=""
- SET ZTIO=IO
- Begin DoDot:1
- +4 SET ZTDESC="OUTSTANDING OBLIGATION REPORT"
- +5 SET ZTRTN="RPT^PRCFOOR4"
- SET ZTSAVE("PRC*")=""
- +6 DO ^%ZTLOAD
- End DoDot:1
- QUIT
- RPT ;
- +1 SET (PRCFAT,PRCFAS,PRCFCT,PRCFCS,PRCFOT,PRCFOS)=0
- +2 SET DIC="^PRCU(420.96,"
- SET FLDS="[PRCFOOR4]"
- SET BY="[PRCFOOR4]"
- if $DATA(ION)
- SET IOP=ION
- +3 SET FR=PRC("SITE")
- SET TO=PRC("SITE")
- SET DIOEND="D B^PRCFOOR5"
- SET DHD="OUTSTANDING OBLIGATION REPORT"
- +4 DO EN1^DIP
- +5 QUIT
- PRINT2 ;PRINT REPORT OF ERRORS ON FCP CONVERSION - FILE 420.98
- +1 QUIT
- RESTART ;OPTION ENTRY POINT TO RESTART FAILED OUTSTANDING OBLIGATION REPORT
- +1 ;ASK FOR MESSAGE NUMBER IN 423.6
- +2 ;ASK FOR DEVICE
- +3 ;SET VARIABLE PRCDA=INTERNAL REFERENCE NUMBER IN 423.6
- +4 SET DIC="^PRCF(423.6,"
- SET DIC(0)="AEQ"
- DO ^DIC
- if Y<0
- QUIT
- +5 SET PRCDA=+Y
- +6 ;W ! K IO("Q") S %ZIS("B")="HOME",%ZIS="QM" D ^%ZIS Q:POP
- +7 ;I $D(IO("Q")) S ZTDTH="",ZTIO=IO D
- +8 ;.S ZTDESC="OUTSTANDING OBLIGATION REPORT"
- +9 ;.S ZTRTN="^PRCFOOR3",ZTSAVE("PRC*")=""
- +10 ;.S ZTIO="" D ^%ZTLOAD
- +11 SET ZTDESC="OUTSTANDING OBLIGATION REPORT"
- +12 SET ZTRTN="^PRCFOOR3"
- SET ZTSAVE("PRC*")=""
- +13 SET ZTIO=""
- DO ^%ZTLOAD
- +14 QUIT
- +15 ;D ^PRCFOOR3
- +16 ;D ^%ZISC
- +17 QUIT
- RESTART1 ;OPTION ENTRY POINT TO RESTART FAILED FCP CONVERSION
- +1 ;ASK FOR MESSAGE NUMBER IN 423.6
- +2 ;SET VARIABLE PRCDA=INTERNAL REFERENCE NUMBER IN 423.6
- +3 ;ASK FOR DEVICE
- +4 SET DIC="^PRCF(423.6,"
- SET DIC(0)="AEQ"
- DO ^DIC
- if Y<0
- QUIT
- +5 SET PRCDA=+Y
- +6 WRITE !
- KILL IO("Q")
- SET %ZIS("B")="HOME"
- SET %ZIS="QM"
- DO ^%ZIS
- if POP
- QUIT
- +7 IF $DATA(IO("Q"))
- SET ZTDTH=""
- SET ZTIO=IO
- Begin DoDot:1
- +8 SET ZTDESC="FUND CONTROL POINT CONVERSION"
- +9 SET ZTRTN="^PRCFOOR2"
- SET ZTSAVE("PRC*")=""
- +10 DO ^%ZTLOAD
- End DoDot:1
- +11 DO ^PRCFOOR2
- +12 DO ^%ZISC
- +13 QUIT
- CLEAN(SITE) ;REMOVE ALL RECORDS FROM FILE 420.96 WITH STATION NUMBER (SITE)
- +1 NEW N,DA,DIK
- +2 SET DIK="^PRCU(420.96,"
- +3 SET DA=0
- FOR
- SET DA=$ORDER(^PRCU(420.96,DA))
- if 'DA
- QUIT
- SET X=$PIECE(^(DA,0),"^",8)
- IF X=""!(X=SITE)
- DO ^DIK
- +4 QUIT