PRCAPCL ;WASH-ISC@ALTOONA,PA/NYB - Print Bill Status Report ;8/19/94 10:21 AM
V ;;4.5;Accounts Receivable;**72,63,143,154,315,342,368,391,389**;Mar 20, 1995;Build 36
;;Per VA Directive 6402, this routine should not be modified.
;
;PRCA*4.5*368 Instead of relying on the suspended tx for a bill
; loop in reverse until the newest suspended tx is found
;
N BAL,BN,CAT,DEAD,DEBT,DIR,DIROUT,DUOUT,DP,DP2,HDR,IOP,N430
N PAGE,POP,PRCAE,PRCATOT,PRCATOT2,PRCAT,PRCAT2,PRCY,RCDOJ,TDT,ST,STT
S (PAGE,PRCAT,PRCAT2,PRCATOT,PRCATOT2,HDR)=0
D NOW^%DTC S Y=% X ^DD("DD") S TDT=Y
I $G(STAT)="ALL" S STT=0 F S STT=($O(^PRCA(430.3,"AC",STT))) Q:STT="" D
. I STT<100!(STT=107) Q
. S STAT($O(^PRCA(430.3,"AC",STT,0)))=""
. Q
S STAT=0 F S STAT=$O(STAT(STAT)) Q:STAT=""!($D(DIROUT))!($D(DUOUT)) D
. N NDE
. D HDR
. F PRCAE=0:0 S PRCAE=$O(^PRCA(430,"AC",STAT,PRCAE)),X="" Q:'PRCAE!($D(DIROUT)!($D(DUOUT))) I $P($G(^PRCA(430,PRCAE,100)),"^",2)[$G(SER),$S($G(SER):+$G(^PRCA(430,PRCAE,100)),1:1) D Q:$D(DIROUT)!($D(DUOUT)) D PRNTL
.. I $Y+4>IOSL D TOP,HDR
. I $Y+4>IOSL D TOP,HDR Q:$D(DIROUT)!($D(DUOUT))
. S DP2=$S(+$P($G(DAT),"^",2)=0:"",1:+$P($G(DAT),"^",2))
. S ST="" F S ST=$O(^TMP($J,"PRCAE",ST)) Q:ST=""!($D(DIROUT)!($D(DUOUT))) D
.. I STAT=40 D STHDR
.. S DP=0 F S DP=$O(^TMP($J,"PRCAE",ST,DP)) Q:'DP!($D(DIROUT)!($D(DUOUT))) D
... S BN="" F S BN=$O(^TMP($J,"PRCAE",ST,DP,BN)) Q:BN=""!($D(DIROUT)!($D(DUOUT))) D
.... S NDE=^TMP($J,"PRCAE",ST,DP,BN)
.... S Y=DP X ^DD("DD") S DP2=Y K Y
.... S RCDOJ=$$REFST^RCRCUTL(+$O(^PRCA(430,"B",BN,0)))
.... W $G(DP2),?15,$S(RCDOJ&$G(BN):$G(BN)_"r",1:$G(BN)),?30,$P(NDE,U,2),?45,$P(NDE,U,3)
.... W ?65,$J($P(NDE,U,4),9,2),!
.... S PRCATOT2=PRCATOT2+$P(NDE,U,4),PRCAT2=PRCAT2+1
.... S PRCATOT=PRCATOT+$P(NDE,U,4),PRCAT=PRCAT+1
.... I $Y+4>IOSL D TOP,HDR Q:$D(DIROUT)!($D(DUOUT)) I STAT=40 D STHDR
.... K ^TMP($J,"PRCAE",ST,DP,BN)
. I X'="^" W !!!,"SUBTOTAL: ",$J(PRCATOT2,10,2),!,"SUBCOUNT: ",$J(PRCAT2,10),?30 Q:$D(DIROUT)!($D(DUOUT))
. S (PRCATOT2,PRCAT2)=0
. Q:$D(DIROUT)!($D(DUOUT))
. I $O(STAT(STAT))="" Q
. I $O(STAT(STAT))'="" W !! D TOP
I X'="^" W !!!,"TOTAL: ",$J(PRCATOT,10,2),!,"COUNT: ",$J(PRCAT,10),!," MEAN: ",$J($S('PRCAT:0,1:PRCATOT/PRCAT),10,2),?30,"* -indicates that patient is deceased",!,?30,"r -indicates that bill is referred"
W:$E(IOST)="P" @IOF Q
TOP ;
I $E(IOST)="C" S X="" S DIR(0)="E" D ^DIR Q:$D(DIROUT)!($D(DUOUT))
Q2 Q
PRNTL ;
N BAL,DFN,DEAD,DEBT,ST
S X=$S($D(^PRCA(430,PRCAE,0)):^(0),1:"") G:X="" PQ
S BN=$P($G(X),U),DP=$P($G(X),U,14),PRCY=$P($G(X),U,2) G:BN="" PQ
S BEG=+DAT-1,END=+$P(DAT,U,2)
S ST=12 I STAT=40 D SUST ;PRCA*4.5*315/DRF Find suspended type
I BEG,DP'>BEG Q
I END,DP>END Q
I STAT=40,PRSELST'="",PRSELST'="A",PRSELST'[(","_ST_",") Q ; Quit if suspended type is not selected PRCA*4.5*391
S (CAT,PRCY)=$S(PRCY="":PRCY,$D(^PRCA(430.2,PRCY,0))#2:$P(^(0),U),1:PRCY)
S PRCY=$S($D(^RCD(340,+$P(X,U,9),0)):$P(^(0),U),1:"")
I PRCY["DPT" S DFN=+PRCY D DEM^VADPT S:+VADM(6) DEAD="*" D KVAR^VADPT K VA,VADM
I PRCY]"" S (DEBT,PRCY)=$S($D(@("^"_$P(PRCY,";",2)_+PRCY_",0)")):^(0),1:"")
S PRCY=$S($D(^PRCA(430,PRCAE,7)):^(7),1:"")
I 'PRCY,(STAT=$O(^PRCA(430.3,"AC",104,0))!((STAT=20)&($G(^PRCA(430,PRCAE,100)))))
S (BAL,PRCY)=$P(PRCY,U)+$P(PRCY,U,2)+$P(PRCY,U,3)+$P(PRCY,U,4)+$P(PRCY,U,5)
I DP'="" S ^TMP($J,"PRCAE",ST,DP,BN)=U_$E(CAT,1,13)_U_$G(DEAD)_$E($P($G(DEBT),U),1,15)_U_$G(BAL)_U_$G(PRCATOT2)_U_$G(PRCAT2)
I $G(SER),(STAT=31!(STAT=32)) S Y=$G(^PRCA(430,PRCAE,3)) D
. W:$P(Y,U)]"" !,"Date: ",$E($P(Y,U),4,5),"/",$E($P(Y,U),6,7),"/",$E($P(Y,U),2,3)
. W:$P(Y,U,2)]"" " By: ",$P($G(^VA(200,+$P(Y,U,2),0)),U)
. W:$P(Y,U,6)]"" " Reason: ",$P(Y,U,6)
. Q
I $E(IOST)="",$Y+4>IOSL D TOP
PQ Q
HDR ;
I $E(IOST)="C"!PAGE W @IOF
S PAGE=PAGE+1
W !,"BILL STATUS LISTING REPORT"
W ?40,$G(TDT),?72,$G(PAGE)
W !,"Sort Criteria for Date Last Updated Range: "_SC1_" to "_SC2
W !,"Date Last",!," Updated",?15,"Bill no.",?30,"Category"
W ?50,"Debtor",?68,"Balance",!
S X="",$P(X,"-",IOM-1)="" W X,!
W !,?5,"Status: ",$P($S($D(^PRCA(430.3,STAT,0)):^(0),1:""),U)
S HDR=1
W !!
Q
DT I Y X ^DD("DD") S DP2=Y
Q
STAT(SER) W ! ;Bill Status Listing
N BEG,CH,DAT,END,I,PRSELST,SC1,SC2,STAT,STT,XX
K ^TMP($J)
S DAT=$$DATE^RCEVUTL1("")
Q:$G(DAT)=-1
S PRSELST="" ; PRCA*4.5*389
S BEG=+DAT,END=+$P(DAT,U,2)
S SC1=$S(BEG=0:"First",1:BEG-1) I +$G(SC1) S Y=SC1+1 X ^DD("DD") S SC1=Y
S SC2=$S(END=0:"Last",1:END) I +$G(SC2) S Y=SC2 X ^DD("DD") S SC2=Y
D ST
Q:STAT="^"
D TSK,Q1
Q
ST N DIC,X,Y
S DIC="^PRCA(430.3,",DIC(0)="QEMZ"
S DIC("S")="I $P(^(0),""^"",3)>100,($P(^(0),""^"",3)'=107)"
S Y=0 W !,"STATUS: "_$S('$O(STAT("")):"ALL// ",1:"")
R X:DTIME I '$T!(X="^") S STAT="^" Q
I ((X="")!(X="ALL")),'$O(STAT("")) S (STAT,X)="ALL" Q
I X="" Q
D ^DIC S STAT=+Y,SER=$G(SER)
I X["?" W !!,"Enter 'ALL' for all status types.",! G ST
I STAT'="ALL",(+STAT>0) S STAT(+STAT)="" S:STAT=40 PRSELST=$$STYPSEL() G ST ; PRCA*4.5*391
G:+STAT<0 ST
Q
;
SUST ;Look for suspended type for a suspended bill PRCA*4.5*315/DRF
;Look for suspended type for suspended bill even if not last bill tx ;PRCA*4.5*368
N PRCATX S PRCATX="A",ST=""
F S PRCATX=$O(^PRCA(433,"C",PRCAE,PRCATX),-1) Q:PRCATX="" D Q:ST ;Quit if no transactions for this entry, PRCA*4.5*342
.I '$D(^PRCA(433,PRCATX,1)) Q
.I $P(^PRCA(433,PRCATX,1),U,2)'=47 Q
.S ST=$P($G(^PRCA(433,PRCATX,1)),U,12) ; PRCA*4.5*391
.Q
Q
STHDR ;Display Suspended Type PRCA*4.5*315/DRF
I 'HDR W !
W ?30,"Suspend Type: ",$$GET1^DIQ(433.001,ST_",",.02),!! ; PRCA*4.5*391
S HDR=0
Q
TSK ;
N POP,ZTSK
W *7,!,"Report should be QUEUED it could take some time to run!"
S POP=0,%ZIS="MQ" D ^%ZIS G:POP Q1
I '$D(IO("Q")) U IO D PRCAPCL U IO(0) G Q1
S ZTRTN="^PRCAPCL"
S (ZTSAVE("BEG"),ZTSAVE("DAT"),ZTSAVE("END"),ZTSAVE("SER"))=""
S (ZTSAVE("STAT"),ZTSAVE("STAT("),ZTSAVE("SC1"),ZTSAVE("SC2"))=""
S ZTSAVE("PRSELST")="" ; PRCA*4.5*391
S ZTDESC="Bill Status Listing" D ^%ZTLOAD
Q1 D ^%ZISC Q
;
STYPSEL() ; get suspension type(s) selection PRCA*4.5*391
;
; returns comma-separated list of selected fiel 433.001 IENs, or "A" for all suspension types, or "" for no selection
;
N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
N RES
S RES=""
W !
S DIR("A")="Run for (A)ll Suspension Types or (S)elected Suspension Types: "
S DIR("A",1)="Suspension type Selection:"
S DIR("?")="^"
S DIR(0)="SA^A:All;S:Selected",DIR("B")="A"
D ^DIR I $D(DIRUT) Q RES
I Y="A" S RES="A" Q RES ; "All Suspension Types" selected
S DIC(0)="ABEOMQ"
S DIC("A")="Select Suspension Type(s): "
S DIC="^PRCA(433.001,"
STYPSEL1 ; Prompt for suspension type selection
W !
D ^DIC
I $D(DUOUT)!$D(DTOUT)!(Y=-1) S RES="" Q RES
S RES=RES_","_$P(Y,U,1)
I $$ANOTHER G STYPSEL1
Q RES_","
;
ANOTHER() ; "Select Another" prompt PRCA*4.5*391
; returns 1, if response was "YES", returns 0 otherwise
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR("A")="Select Another" S DIR(0)="Y",DIR("B")="NO"
D ^DIR I $D(DIRUT) Q 0
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAPCL 7149 printed Dec 13, 2024@01:41:01 Page 2
PRCAPCL ;WASH-ISC@ALTOONA,PA/NYB - Print Bill Status Report ;8/19/94 10:21 AM
V ;;4.5;Accounts Receivable;**72,63,143,154,315,342,368,391,389**;Mar 20, 1995;Build 36
+1 ;;Per VA Directive 6402, this routine should not be modified.
+2 ;
+3 ;PRCA*4.5*368 Instead of relying on the suspended tx for a bill
+4 ; loop in reverse until the newest suspended tx is found
+5 ;
+6 NEW BAL,BN,CAT,DEAD,DEBT,DIR,DIROUT,DUOUT,DP,DP2,HDR,IOP,N430
+7 NEW PAGE,POP,PRCAE,PRCATOT,PRCATOT2,PRCAT,PRCAT2,PRCY,RCDOJ,TDT,ST,STT
+8 SET (PAGE,PRCAT,PRCAT2,PRCATOT,PRCATOT2,HDR)=0
+9 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET TDT=Y
+10 IF $GET(STAT)="ALL"
SET STT=0
FOR
SET STT=($ORDER(^PRCA(430.3,"AC",STT)))
if STT=""
QUIT
Begin DoDot:1
+11 IF STT<100!(STT=107)
QUIT
+12 SET STAT($ORDER(^PRCA(430.3,"AC",STT,0)))=""
+13 QUIT
End DoDot:1
+14 SET STAT=0
FOR
SET STAT=$ORDER(STAT(STAT))
if STAT=""!($DATA(DIROUT))!($DATA(DUOUT))
QUIT
Begin DoDot:1
+15 NEW NDE
+16 DO HDR
+17 FOR PRCAE=0:0
SET PRCAE=$ORDER(^PRCA(430,"AC",STAT,PRCAE))
SET X=""
if 'PRCAE!($DATA(DIROUT)!($DATA(DUOUT)))
QUIT
IF $PIECE($GET(^PRCA(430,PRCAE,100)),"^",2)[$GET(SER)
IF $SELECT($GET(SER):+$GET(^PRCA(430,PRCAE,100)),1:1)
Begin DoDot:2
+18 IF $Y+4>IOSL
DO TOP
DO HDR
End DoDot:2
if $DATA(DIROUT)!($DATA(DUOUT))
QUIT
DO PRNTL
+19 IF $Y+4>IOSL
DO TOP
DO HDR
if $DATA(DIROUT)!($DATA(DUOUT))
QUIT
+20 SET DP2=$SELECT(+$PIECE($GET(DAT),"^",2)=0:"",1:+$PIECE($GET(DAT),"^",2))
+21 SET ST=""
FOR
SET ST=$ORDER(^TMP($JOB,"PRCAE",ST))
if ST=""!($DATA(DIROUT)!($DATA(DUOUT)))
QUIT
Begin DoDot:2
+22 IF STAT=40
DO STHDR
+23 SET DP=0
FOR
SET DP=$ORDER(^TMP($JOB,"PRCAE",ST,DP))
if 'DP!($DATA(DIROUT)!($DATA(DUOUT)))
QUIT
Begin DoDot:3
+24 SET BN=""
FOR
SET BN=$ORDER(^TMP($JOB,"PRCAE",ST,DP,BN))
if BN=""!($DATA(DIROUT)!($DATA(DUOUT)))
QUIT
Begin DoDot:4
+25 SET NDE=^TMP($JOB,"PRCAE",ST,DP,BN)
+26 SET Y=DP
XECUTE ^DD("DD")
SET DP2=Y
KILL Y
+27 SET RCDOJ=$$REFST^RCRCUTL(+$ORDER(^PRCA(430,"B",BN,0)))
+28 WRITE $GET(DP2),?15,$SELECT(RCDOJ&$GET(BN):$GET(BN)_"r",1:$GET(BN)),?30,$PIECE(NDE,U,2),?45,$PIECE(NDE,U,3)
+29 WRITE ?65,$JUSTIFY($PIECE(NDE,U,4),9,2),!
+30 SET PRCATOT2=PRCATOT2+$PIECE(NDE,U,4)
SET PRCAT2=PRCAT2+1
+31 SET PRCATOT=PRCATOT+$PIECE(NDE,U,4)
SET PRCAT=PRCAT+1
+32 IF $Y+4>IOSL
DO TOP
DO HDR
if $DATA(DIROUT)!($DATA(DUOUT))
QUIT
IF STAT=40
DO STHDR
+33 KILL ^TMP($JOB,"PRCAE",ST,DP,BN)
End DoDot:4
End DoDot:3
End DoDot:2
+34 IF X'="^"
WRITE !!!,"SUBTOTAL: ",$JUSTIFY(PRCATOT2,10,2),!,"SUBCOUNT: ",$JUSTIFY(PRCAT2,10),?30
if $DATA(DIROUT)!($DATA(DUOUT))
QUIT
+35 SET (PRCATOT2,PRCAT2)=0
+36 if $DATA(DIROUT)!($DATA(DUOUT))
QUIT
+37 IF $ORDER(STAT(STAT))=""
QUIT
+38 IF $ORDER(STAT(STAT))'=""
WRITE !!
DO TOP
End DoDot:1
+39 IF X'="^"
WRITE !!!,"TOTAL: ",$JUSTIFY(PRCATOT,10,2),!,"COUNT: ",$JUSTIFY(PRCAT,10),!," MEAN: ",$JUSTIFY($SELECT('PRCAT:0,1:PRCATOT/PRCAT),10,2),?30,"* -indicates that patient is deceased",!,?30,"r -indicates that bill is referred"
+40 if $EXTRACT(IOST)="P"
WRITE @IOF
QUIT
TOP ;
+1 IF $EXTRACT(IOST)="C"
SET X=""
SET DIR(0)="E"
DO ^DIR
if $DATA(DIROUT)!($DATA(DUOUT))
QUIT
Q2 QUIT
PRNTL ;
+1 NEW BAL,DFN,DEAD,DEBT,ST
+2 SET X=$SELECT($DATA(^PRCA(430,PRCAE,0)):^(0),1:"")
if X=""
GOTO PQ
+3 SET BN=$PIECE($GET(X),U)
SET DP=$PIECE($GET(X),U,14)
SET PRCY=$PIECE($GET(X),U,2)
if BN=""
GOTO PQ
+4 SET BEG=+DAT-1
SET END=+$PIECE(DAT,U,2)
+5 ;PRCA*4.5*315/DRF Find suspended type
SET ST=12
IF STAT=40
DO SUST
+6 IF BEG
IF DP'>BEG
QUIT
+7 IF END
IF DP>END
QUIT
+8 ; Quit if suspended type is not selected PRCA*4.5*391
IF STAT=40
IF PRSELST'=""
IF PRSELST'="A"
IF PRSELST'[(","_ST_",")
QUIT
+9 SET (CAT,PRCY)=$SELECT(PRCY="":PRCY,$DATA(^PRCA(430.2,PRCY,0))#2:$PIECE(^(0),U),1:PRCY)
+10 SET PRCY=$SELECT($DATA(^RCD(340,+$PIECE(X,U,9),0)):$PIECE(^(0),U),1:"")
+11 IF PRCY["DPT"
SET DFN=+PRCY
DO DEM^VADPT
if +VADM(6)
SET DEAD="*"
DO KVAR^VADPT
KILL VA,VADM
+12 IF PRCY]""
SET (DEBT,PRCY)=$SELECT($DATA(@("^"_$PIECE(PRCY,";",2)_+PRCY_",0)")):^(0),1:"")
+13 SET PRCY=$SELECT($DATA(^PRCA(430,PRCAE,7)):^(7),1:"")
+14 IF 'PRCY
IF (STAT=$ORDER(^PRCA(430.3,"AC",104,0))!((STAT=20)&($GET(^PRCA(430,PRCAE,100)))))
+15 SET (BAL,PRCY)=$PIECE(PRCY,U)+$PIECE(PRCY,U,2)+$PIECE(PRCY,U,3)+$PIECE(PRCY,U,4)+$PIECE(PRCY,U,5)
+16 IF DP'=""
SET ^TMP($JOB,"PRCAE",ST,DP,BN)=U_$EXTRACT(CAT,1,13)_U_$GET(DEAD)_$EXTRACT($PIECE($GET(DEBT),U),1,15)_U_$GET(BAL)_U_$GET(PRCATOT2)_U_$GET(PRCAT2)
+17 IF $GET(SER)
IF (STAT=31!(STAT=32))
SET Y=$GET(^PRCA(430,PRCAE,3))
Begin DoDot:1
+18 if $PIECE(Y,U)]""
WRITE !,"Date: ",$EXTRACT($PIECE(Y,U),4,5),"/",$EXTRACT($PIECE(Y,U),6,7),"/",$EXTRACT($PIECE(Y,U),2,3)
+19 if $PIECE(Y,U,2)]""
WRITE " By: ",$PIECE($GET(^VA(200,+$PIECE(Y,U,2),0)),U)
+20 if $PIECE(Y,U,6)]""
WRITE " Reason: ",$PIECE(Y,U,6)
+21 QUIT
End DoDot:1
+22 IF $EXTRACT(IOST)=""
IF $Y+4>IOSL
DO TOP
PQ QUIT
HDR ;
+1 IF $EXTRACT(IOST)="C"!PAGE
WRITE @IOF
+2 SET PAGE=PAGE+1
+3 WRITE !,"BILL STATUS LISTING REPORT"
+4 WRITE ?40,$GET(TDT),?72,$GET(PAGE)
+5 WRITE !,"Sort Criteria for Date Last Updated Range: "_SC1_" to "_SC2
+6 WRITE !,"Date Last",!," Updated",?15,"Bill no.",?30,"Category"
+7 WRITE ?50,"Debtor",?68,"Balance",!
+8 SET X=""
SET $PIECE(X,"-",IOM-1)=""
WRITE X,!
+9 WRITE !,?5,"Status: ",$PIECE($SELECT($DATA(^PRCA(430.3,STAT,0)):^(0),1:""),U)
+10 SET HDR=1
+11 WRITE !!
+12 QUIT
DT IF Y
XECUTE ^DD("DD")
SET DP2=Y
+1 QUIT
STAT(SER) ;Bill Status Listing
WRITE !
+1 NEW BEG,CH,DAT,END,I,PRSELST,SC1,SC2,STAT,STT,XX
+2 KILL ^TMP($JOB)
+3 SET DAT=$$DATE^RCEVUTL1("")
+4 if $GET(DAT)=-1
QUIT
+5 ; PRCA*4.5*389
SET PRSELST=""
+6 SET BEG=+DAT
SET END=+$PIECE(DAT,U,2)
+7 SET SC1=$SELECT(BEG=0:"First",1:BEG-1)
IF +$GET(SC1)
SET Y=SC1+1
XECUTE ^DD("DD")
SET SC1=Y
+8 SET SC2=$SELECT(END=0:"Last",1:END)
IF +$GET(SC2)
SET Y=SC2
XECUTE ^DD("DD")
SET SC2=Y
+9 DO ST
+10 if STAT="^"
QUIT
+11 DO TSK
DO Q1
+12 QUIT
ST NEW DIC,X,Y
+1 SET DIC="^PRCA(430.3,"
SET DIC(0)="QEMZ"
+2 SET DIC("S")="I $P(^(0),""^"",3)>100,($P(^(0),""^"",3)'=107)"
+3 SET Y=0
WRITE !,"STATUS: "_$SELECT('$ORDER(STAT("")):"ALL// ",1:"")
+4 READ X:DTIME
IF '$TEST!(X="^")
SET STAT="^"
QUIT
+5 IF ((X="")!(X="ALL"))
IF '$ORDER(STAT(""))
SET (STAT,X)="ALL"
QUIT
+6 IF X=""
QUIT
+7 DO ^DIC
SET STAT=+Y
SET SER=$GET(SER)
+8 IF X["?"
WRITE !!,"Enter 'ALL' for all status types.",!
GOTO ST
+9 ; PRCA*4.5*391
IF STAT'="ALL"
IF (+STAT>0)
SET STAT(+STAT)=""
if STAT=40
SET PRSELST=$$STYPSEL()
GOTO ST
+10 if +STAT<0
GOTO ST
+11 QUIT
+12 ;
SUST ;Look for suspended type for a suspended bill PRCA*4.5*315/DRF
+1 ;Look for suspended type for suspended bill even if not last bill tx ;PRCA*4.5*368
+2 NEW PRCATX
SET PRCATX="A"
SET ST=""
+3 ;Quit if no transactions for this entry, PRCA*4.5*342
FOR
SET PRCATX=$ORDER(^PRCA(433,"C",PRCAE,PRCATX),-1)
if PRCATX=""
QUIT
Begin DoDot:1
+4 IF '$DATA(^PRCA(433,PRCATX,1))
QUIT
+5 IF $PIECE(^PRCA(433,PRCATX,1),U,2)'=47
QUIT
+6 ; PRCA*4.5*391
SET ST=$PIECE($GET(^PRCA(433,PRCATX,1)),U,12)
+7 QUIT
End DoDot:1
if ST
QUIT
+8 QUIT
STHDR ;Display Suspended Type PRCA*4.5*315/DRF
+1 IF 'HDR
WRITE !
+2 ; PRCA*4.5*391
WRITE ?30,"Suspend Type: ",$$GET1^DIQ(433.001,ST_",",.02),!!
+3 SET HDR=0
+4 QUIT
TSK ;
+1 NEW POP,ZTSK
+2 WRITE *7,!,"Report should be QUEUED it could take some time to run!"
+3 SET POP=0
SET %ZIS="MQ"
DO ^%ZIS
if POP
GOTO Q1
+4 IF '$DATA(IO("Q"))
USE IO
DO PRCAPCL
USE IO(0)
GOTO Q1
+5 SET ZTRTN="^PRCAPCL"
+6 SET (ZTSAVE("BEG"),ZTSAVE("DAT"),ZTSAVE("END"),ZTSAVE("SER"))=""
+7 SET (ZTSAVE("STAT"),ZTSAVE("STAT("),ZTSAVE("SC1"),ZTSAVE("SC2"))=""
+8 ; PRCA*4.5*391
SET ZTSAVE("PRSELST")=""
+9 SET ZTDESC="Bill Status Listing"
DO ^%ZTLOAD
Q1 DO ^%ZISC
QUIT
+1 ;
STYPSEL() ; get suspension type(s) selection PRCA*4.5*391
+1 ;
+2 ; returns comma-separated list of selected fiel 433.001 IENs, or "A" for all suspension types, or "" for no selection
+3 ;
+4 NEW DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+5 NEW RES
+6 SET RES=""
+7 WRITE !
+8 SET DIR("A")="Run for (A)ll Suspension Types or (S)elected Suspension Types: "
+9 SET DIR("A",1)="Suspension type Selection:"
+10 SET DIR("?")="^"
+11 SET DIR(0)="SA^A:All;S:Selected"
SET DIR("B")="A"
+12 DO ^DIR
IF $DATA(DIRUT)
QUIT RES
+13 ; "All Suspension Types" selected
IF Y="A"
SET RES="A"
QUIT RES
+14 SET DIC(0)="ABEOMQ"
+15 SET DIC("A")="Select Suspension Type(s): "
+16 SET DIC="^PRCA(433.001,"
STYPSEL1 ; Prompt for suspension type selection
+1 WRITE !
+2 DO ^DIC
+3 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y=-1)
SET RES=""
QUIT RES
+4 SET RES=RES_","_$PIECE(Y,U,1)
+5 IF $$ANOTHER
GOTO STYPSEL1
+6 QUIT RES_","
+7 ;
ANOTHER() ; "Select Another" prompt PRCA*4.5*391
+1 ; returns 1, if response was "YES", returns 0 otherwise
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+3 WRITE !
+4 SET DIR("A")="Select Another"
SET DIR(0)="Y"
SET DIR("B")="NO"
+5 DO ^DIR
IF $DATA(DIRUT)
QUIT 0
+6 QUIT Y
