- PRCFATM ;WISC/SJG-DISPLAY TYPES/COUNTS OF ACCTG TECH DOCUMENTS ;12/14/93 10:15
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- EN ;
- QUIT
- D PROMPT Q:'Y Q:$D(DIRUT)
- S PRCF("X")="AS" D ^PRCFSITE Q:'%
- W ! D WAIT^DICD W !
- D HILO^PRCFQ
- D HDR,ENPO,ENPOA,ENRR
- W ! D ENCON^PRCFQ W !
- QUIT
- ENPO ;COUNT/DISPLAY PURCHASE ORDERS
- S TYPE="Purchase Order",FLAG=0
- F LOOP=10,15,20 S TAG="EN"_LOOP D @TAG
- W:'FLAG !?3,"There are no PURCHASE ORDERS ready for processing at this time.",!
- D EXMAIN
- QUIT
- ENPOA ;COUNT/DISPLAY PURCHASE ORDER AMENDMENTS
- S TYPE="Purchase Order Amendment",FLAG=0
- F LOOP=26,41,31,36 S TAG="EN"_LOOP D @TAG
- W:'FLAG ?3,"There are no PURCHASE ORDER AMENDMENTS ready for processing at this time.",!
- D EXMAIN
- QUIT
- ENRR ;COUNT/DISPLAY RECEIVING REPORTS
- S TYPE="Receiving Report",FLAG=0
- F LOOP=35,30,36,31 S TAG="EN"_LOOP D @TAG
- W:'FLAG ?3,"There are no RECEIVING REPORTS ready for processing at this time.",!
- D EXMAIN
- QUIT
- EN10 ;COUNT 'PENDING FISCAL ACTION' STATUS
- S FSO=10 D WORK S:X FLAG=1 D EXPO
- Q
- EN26 ;COUNT 'ORDERED AND OBLIGATED (AMENDED)' STATUS
- S FSO=26 D WORK S:X FLAG=1 D EXPO
- Q
- EN30 ;COUNT 'PARTIAL ORDER RECEIVED' STATUS
- S FSO=30 D WORK S:X FLAG=1 D EXPO
- Q
- EN31 ;COUNT 'PARTIAL ORDER RECEIVED (AMENDED)' STATUS
- S FSO=31 D WORK S:X FLAG=1 D EXPO
- Q
- EN15 ;COUNT 'PARTIAL ORDER RECEIVED BUT NOT OBLIGATED' STATUS
- S FSO=15 D WORK S:X FLAG=1 D EXPO
- Q
- EN35 ;COUNT 'COMPLETE ORDER RECEIVED' STATUS
- S FSO=35 D WORK S:X FLAG=1 D EXPO
- Q
- EN36 ;COUNT 'COMPLETE ORDER RECEIVED (AMENDED)' STATUS
- S FSO=36 D WORK S:X FLAG=1 D EXPO
- Q
- EN20 ;COUNT 'COMPLETE ORDER RECEIVED BUT NOT OBLIGATED' STATUS
- S FSO=20 D WORK S:X FLAG=1 D EXPO
- Q
- EN41 ;COUNT 'TRANSACTION COMPLETE (AMENDED)' STATUS
- S FSO=41 D WORK S:X FLAG=1 D EXPO
- Q
- HDR ;
- W IOINHI,!!?3,"The following documents are ready for processing:",!
- W !?3,"Number",?11,"Type",?38,"Status",!
- N LINE S LINE="",$P(LINE,"-",75)="" W ?3,LINE K LINE W IOINORM
- K IOINLO,IOINHI,IOINORM
- Q
- WORK D STATUS,COUNT,DISP
- Q
- STATUS ;GET DOCUMENT STATUS
- S DIC=442.3,D="AC",DIC(0)="N",X=FSO D IX^DIC K DIC Q:Y<0
- Q
- COUNT ;COUNT ENTRIES IN X-REF
- S X=0,I="" F S I=$O(^PRC(442,"AI",FSO,I)) Q:I="" K TX S TX=$G(^PRC(442,I,0)) I $P(TX,"-")=PRC("SITE") S X=X+1
- Q
- DISP ;DISPLAY COUNT OF ENTRIES
- Q:'X
- W !?3,$J(X,6),?11,TYPE,?38,$P(Y,"^",2)
- Q
- EXPO ;EXIT POINT FOR PURCHASE ORDER, AMENDMENTS, RECEIVING REPORTS
- KILL I,FSO,X,Y
- QUIT
- EXMAIN ;MAIN EXIT POINT
- KILL LOOP,TAG,TYPE,FLAG,TX
- QUIT
- PROMPT ; Prompt user if report should be run
- S DIR(0)="Y",DIR("A")="Do you want to run the report at this time",DIR("B")="NO"
- S DIR("A",1)=" ",DIR("A",2)="The system can now generate a report that will list the type and number"
- S DIR("A",3)="of each document that is ready for processing at this time."
- S DIR("A",4)=" ",DIR("A",5)="But, it may take a while to complete.",DIR("A",6)=" "
- S DIR("?")="Enter 'NO' or 'N' or 'RETURN' if the report should not be run at this time."
- S DIR("?",1)="Enter 'YES' or 'Y' to run the report"
- D ^DIR K DIR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFATM 3149 printed Feb 18, 2025@23:29 Page 2
- PRCFATM ;WISC/SJG-DISPLAY TYPES/COUNTS OF ACCTG TECH DOCUMENTS ;12/14/93 10:15
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;
- EN ;
- +1 QUIT
- +2 DO PROMPT
- if 'Y
- QUIT
- if $DATA(DIRUT)
- QUIT
- +3 SET PRCF("X")="AS"
- DO ^PRCFSITE
- if '%
- QUIT
- +4 WRITE !
- DO WAIT^DICD
- WRITE !
- +5 DO HILO^PRCFQ
- +6 DO HDR
- DO ENPO
- DO ENPOA
- DO ENRR
- +7 WRITE !
- DO ENCON^PRCFQ
- WRITE !
- +8 QUIT
- ENPO ;COUNT/DISPLAY PURCHASE ORDERS
- +1 SET TYPE="Purchase Order"
- SET FLAG=0
- +2 FOR LOOP=10,15,20
- SET TAG="EN"_LOOP
- DO @TAG
- +3 if 'FLAG
- WRITE !?3,"There are no PURCHASE ORDERS ready for processing at this time.",!
- +4 DO EXMAIN
- +5 QUIT
- ENPOA ;COUNT/DISPLAY PURCHASE ORDER AMENDMENTS
- +1 SET TYPE="Purchase Order Amendment"
- SET FLAG=0
- +2 FOR LOOP=26,41,31,36
- SET TAG="EN"_LOOP
- DO @TAG
- +3 if 'FLAG
- WRITE ?3,"There are no PURCHASE ORDER AMENDMENTS ready for processing at this time.",!
- +4 DO EXMAIN
- +5 QUIT
- ENRR ;COUNT/DISPLAY RECEIVING REPORTS
- +1 SET TYPE="Receiving Report"
- SET FLAG=0
- +2 FOR LOOP=35,30,36,31
- SET TAG="EN"_LOOP
- DO @TAG
- +3 if 'FLAG
- WRITE ?3,"There are no RECEIVING REPORTS ready for processing at this time.",!
- +4 DO EXMAIN
- +5 QUIT
- EN10 ;COUNT 'PENDING FISCAL ACTION' STATUS
- +1 SET FSO=10
- DO WORK
- if X
- SET FLAG=1
- DO EXPO
- +2 QUIT
- EN26 ;COUNT 'ORDERED AND OBLIGATED (AMENDED)' STATUS
- +1 SET FSO=26
- DO WORK
- if X
- SET FLAG=1
- DO EXPO
- +2 QUIT
- EN30 ;COUNT 'PARTIAL ORDER RECEIVED' STATUS
- +1 SET FSO=30
- DO WORK
- if X
- SET FLAG=1
- DO EXPO
- +2 QUIT
- EN31 ;COUNT 'PARTIAL ORDER RECEIVED (AMENDED)' STATUS
- +1 SET FSO=31
- DO WORK
- if X
- SET FLAG=1
- DO EXPO
- +2 QUIT
- EN15 ;COUNT 'PARTIAL ORDER RECEIVED BUT NOT OBLIGATED' STATUS
- +1 SET FSO=15
- DO WORK
- if X
- SET FLAG=1
- DO EXPO
- +2 QUIT
- EN35 ;COUNT 'COMPLETE ORDER RECEIVED' STATUS
- +1 SET FSO=35
- DO WORK
- if X
- SET FLAG=1
- DO EXPO
- +2 QUIT
- EN36 ;COUNT 'COMPLETE ORDER RECEIVED (AMENDED)' STATUS
- +1 SET FSO=36
- DO WORK
- if X
- SET FLAG=1
- DO EXPO
- +2 QUIT
- EN20 ;COUNT 'COMPLETE ORDER RECEIVED BUT NOT OBLIGATED' STATUS
- +1 SET FSO=20
- DO WORK
- if X
- SET FLAG=1
- DO EXPO
- +2 QUIT
- EN41 ;COUNT 'TRANSACTION COMPLETE (AMENDED)' STATUS
- +1 SET FSO=41
- DO WORK
- if X
- SET FLAG=1
- DO EXPO
- +2 QUIT
- HDR ;
- +1 WRITE IOINHI,!!?3,"The following documents are ready for processing:",!
- +2 WRITE !?3,"Number",?11,"Type",?38,"Status",!
- +3 NEW LINE
- SET LINE=""
- SET $PIECE(LINE,"-",75)=""
- WRITE ?3,LINE
- KILL LINE
- WRITE IOINORM
- +4 KILL IOINLO,IOINHI,IOINORM
- +5 QUIT
- WORK DO STATUS
- DO COUNT
- DO DISP
- +1 QUIT
- STATUS ;GET DOCUMENT STATUS
- +1 SET DIC=442.3
- SET D="AC"
- SET DIC(0)="N"
- SET X=FSO
- DO IX^DIC
- KILL DIC
- if Y<0
- QUIT
- +2 QUIT
- COUNT ;COUNT ENTRIES IN X-REF
- +1 SET X=0
- SET I=""
- FOR
- SET I=$ORDER(^PRC(442,"AI",FSO,I))
- if I=""
- QUIT
- KILL TX
- SET TX=$GET(^PRC(442,I,0))
- IF $PIECE(TX,"-")=PRC("SITE")
- SET X=X+1
- +2 QUIT
- DISP ;DISPLAY COUNT OF ENTRIES
- +1 if 'X
- QUIT
- +2 WRITE !?3,$JUSTIFY(X,6),?11,TYPE,?38,$PIECE(Y,"^",2)
- +3 QUIT
- EXPO ;EXIT POINT FOR PURCHASE ORDER, AMENDMENTS, RECEIVING REPORTS
- +1 KILL I,FSO,X,Y
- +2 QUIT
- EXMAIN ;MAIN EXIT POINT
- +1 KILL LOOP,TAG,TYPE,FLAG,TX
- +2 QUIT
- PROMPT ; Prompt user if report should be run
- +1 SET DIR(0)="Y"
- SET DIR("A")="Do you want to run the report at this time"
- SET DIR("B")="NO"
- +2 SET DIR("A",1)=" "
- SET DIR("A",2)="The system can now generate a report that will list the type and number"
- +3 SET DIR("A",3)="of each document that is ready for processing at this time."
- +4 SET DIR("A",4)=" "
- SET DIR("A",5)="But, it may take a while to complete."
- SET DIR("A",6)=" "
- +5 SET DIR("?")="Enter 'NO' or 'N' or 'RETURN' if the report should not be run at this time."
- +6 SET DIR("?",1)="Enter 'YES' or 'Y' to run the report"
- +7 DO ^DIR
- KILL DIR
- +8 QUIT