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 Dec 13, 2024@01:40:19 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
