- PRCALST1 ;SF-ISC/YJK-AR LIST,REPORT ;7/14/93 8:46 AM
- V ;;4.5;Accounts Receivable;**72,104**;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- EN N CAT,CAT1,CAT2,CNO,CNT,CT3,CT4,DAT,DHD,DHIT,DISUPNO,DIOBEG
- N DT1,DT2,FT,FT2,IOP,LST,LST2,OT,PAGE,POP,PRCA,PRCAE,SAVIOP
- N SC1,SC2,SCT,SDT,SER,SRT,ST,STT,ST2,ST3,TMP,X,Y,ZTSK
- K ^TMP($J)
- S (CAT,OT)="",CNT=0
- S DAT=$$DATE^RCEVUTL1("^^^P^")
- S DT1=$S($P(DAT,"^")=0:"",1:+DAT)
- Q:+DT1<0
- S DT2=$P(DAT,"^",2),DT2=$S(DT2=0:"",1:DT2)
- Q:+DT2<0
- S SC1=$S(DT1="":"First",1:DT1) I +SC1>0 S Y=SC1 X ^DD("DD") S SC1=Y
- S SC2=$S(DT2="":"Last",1:DT2) I +SC2>0 S Y=SC2 X ^DD("DD") S SC2=Y
- CAT K DIC S Y=0
- W !,"CATEGORY OF BILL: "_$S('$O(^TMP($J,"PRCAT",0)):"ALL// ",1:"")
- R X:DTIME I '$T!(X="^") Q
- I ((X="")!(X="ALL")),'$O(^TMP($J,"PRCAT",0)) S (CAT,X)="ALL" D ST Q:X="^" G MAS
- S DIC="^PRCA(430.2,",DIC(0)="QEMZ"
- D ^DIC S CAT=+Y
- I X["?" W !!,"Enter 'ALL' categories or bills.",! G CAT
- I CAT'="ALL",(+CAT>0) S ^TMP($J,"PRCAT",+CAT)="" G CAT
- I X="" D ST Q:X="^" G MAS
- G:+CAT<0 CAT
- MAS N CT3
- D NOW^%DTC S Y=% X ^DD("DD") S SDT=Y,PAGE=1
- D PRINT Q:OT="^"
- I POP!($D(IO("Q"))) K IO("Q") D ^%ZISC Q
- D EN^PRCAREPC
- D ^%ZISC
- Q
- PRINT ;Print or Queue report.
- W !! S IOP="Q",POP=0,%ZIS="MQ0"
- D ^%ZIS Q:POP
- S SAVIOP=$G(IOP)
- I $D(IO("Q")) D
- .S ZTRTN="EN^PRCAREPC",(ZTSAVE("CAT"),ZTSAVE("DT1"),ZTSAVE("DT2"))=""
- .S (ZTSAVE("OT"),ZTSAVE("PAGE"),ZTSAVE("SAVIOP"),ZTSAVE("SC1"))=""
- .S (ZTSAVE("SC2"),ZTSAVE("SCT"),ZTSAVE("SDT"),ZTSAVE("ST"))=""
- .S (ZTSAVE("^TMP($J,"))=""
- .S ZTDESC="Category Listing" D ^%ZTLOAD
- .I $G(ZTSK) W !!,"Request Queued"
- .Q
- Q
- ST N DIC,Y
- S DIC="^PRCA(430.3,",DIC(0)="QEMZ",DIC("S")="I $P(^(0),""^"",3)>100"
- S Y=0 W !,"STATUS: "_$S('$O(^TMP($J,"PRCAST",0)):"ALL// ",1:"")
- R X:DTIME I '$T!(X="^") S X="^" Q
- I X=""!(X="ALL"),'$O(^TMP($J,"PRCAST",0)) S (ST,X)="ALL" Q
- I X="" Q
- D ^DIC S ST=+Y,SER=$G(SER)
- I X["?" W !!,"Enter 'ALL' for all status types.",! G ST
- I ST'="ALL",(+ST>0) S ^TMP($J,"PRCAST",+ST)="" G ST
- G:+ST<0 ST
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCALST1 2107 printed Apr 23, 2025@17:54:47 Page 2
- PRCALST1 ;SF-ISC/YJK-AR LIST,REPORT ;7/14/93 8:46 AM
- V ;;4.5;Accounts Receivable;**72,104**;Mar 20, 1995
- +1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- EN NEW CAT,CAT1,CAT2,CNO,CNT,CT3,CT4,DAT,DHD,DHIT,DISUPNO,DIOBEG
- +1 NEW DT1,DT2,FT,FT2,IOP,LST,LST2,OT,PAGE,POP,PRCA,PRCAE,SAVIOP
- +2 NEW SC1,SC2,SCT,SDT,SER,SRT,ST,STT,ST2,ST3,TMP,X,Y,ZTSK
- +3 KILL ^TMP($JOB)
- +4 SET (CAT,OT)=""
- SET CNT=0
- +5 SET DAT=$$DATE^RCEVUTL1("^^^P^")
- +6 SET DT1=$SELECT($PIECE(DAT,"^")=0:"",1:+DAT)
- +7 if +DT1<0
- QUIT
- +8 SET DT2=$PIECE(DAT,"^",2)
- SET DT2=$SELECT(DT2=0:"",1:DT2)
- +9 if +DT2<0
- QUIT
- +10 SET SC1=$SELECT(DT1="":"First",1:DT1)
- IF +SC1>0
- SET Y=SC1
- XECUTE ^DD("DD")
- SET SC1=Y
- +11 SET SC2=$SELECT(DT2="":"Last",1:DT2)
- IF +SC2>0
- SET Y=SC2
- XECUTE ^DD("DD")
- SET SC2=Y
- CAT KILL DIC
- SET Y=0
- +1 WRITE !,"CATEGORY OF BILL: "_$SELECT('$ORDER(^TMP($JOB,"PRCAT",0)):"ALL// ",1:"")
- +2 READ X:DTIME
- IF '$TEST!(X="^")
- QUIT
- +3 IF ((X="")!(X="ALL"))
- IF '$ORDER(^TMP($JOB,"PRCAT",0))
- SET (CAT,X)="ALL"
- DO ST
- if X="^"
- QUIT
- GOTO MAS
- +4 SET DIC="^PRCA(430.2,"
- SET DIC(0)="QEMZ"
- +5 DO ^DIC
- SET CAT=+Y
- +6 IF X["?"
- WRITE !!,"Enter 'ALL' categories or bills.",!
- GOTO CAT
- +7 IF CAT'="ALL"
- IF (+CAT>0)
- SET ^TMP($JOB,"PRCAT",+CAT)=""
- GOTO CAT
- +8 IF X=""
- DO ST
- if X="^"
- QUIT
- GOTO MAS
- +9 if +CAT<0
- GOTO CAT
- MAS NEW CT3
- +1 DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- SET SDT=Y
- SET PAGE=1
- +2 DO PRINT
- if OT="^"
- QUIT
- +3 IF POP!($DATA(IO("Q")))
- KILL IO("Q")
- DO ^%ZISC
- QUIT
- +4 DO EN^PRCAREPC
- +5 DO ^%ZISC
- +6 QUIT
- PRINT ;Print or Queue report.
- +1 WRITE !!
- SET IOP="Q"
- SET POP=0
- SET %ZIS="MQ0"
- +2 DO ^%ZIS
- if POP
- QUIT
- +3 SET SAVIOP=$GET(IOP)
- +4 IF $DATA(IO("Q"))
- Begin DoDot:1
- +5 SET ZTRTN="EN^PRCAREPC"
- SET (ZTSAVE("CAT"),ZTSAVE("DT1"),ZTSAVE("DT2"))=""
- +6 SET (ZTSAVE("OT"),ZTSAVE("PAGE"),ZTSAVE("SAVIOP"),ZTSAVE("SC1"))=""
- +7 SET (ZTSAVE("SC2"),ZTSAVE("SCT"),ZTSAVE("SDT"),ZTSAVE("ST"))=""
- +8 SET (ZTSAVE("^TMP($J,"))=""
- +9 SET ZTDESC="Category Listing"
- DO ^%ZTLOAD
- +10 IF $GET(ZTSK)
- WRITE !!,"Request Queued"
- +11 QUIT
- End DoDot:1
- +12 QUIT
- ST NEW DIC,Y
- +1 SET DIC="^PRCA(430.3,"
- SET DIC(0)="QEMZ"
- SET DIC("S")="I $P(^(0),""^"",3)>100"
- +2 SET Y=0
- WRITE !,"STATUS: "_$SELECT('$ORDER(^TMP($JOB,"PRCAST",0)):"ALL// ",1:"")
- +3 READ X:DTIME
- IF '$TEST!(X="^")
- SET X="^"
- QUIT
- +4 IF X=""!(X="ALL")
- IF '$ORDER(^TMP($JOB,"PRCAST",0))
- SET (ST,X)="ALL"
- QUIT
- +5 IF X=""
- QUIT
- +6 DO ^DIC
- SET ST=+Y
- SET SER=$GET(SER)
- +7 IF X["?"
- WRITE !!,"Enter 'ALL' for all status types.",!
- GOTO ST
- +8 IF ST'="ALL"
- IF (+ST>0)
- SET ^TMP($JOB,"PRCAST",+ST)=""
- GOTO ST
- +9 if +ST<0
- GOTO ST
- +10 QUIT
