PRCA219P ;ALB/RRG - REPORT LIKELY BILLS TO PRINT;;
;;4.5;Accounts Receivable;**219**;Mar 20, 1995;Build 18
Q
;
REPORT ;
;
W !,"This is a report of older bills that will likely print at the next print cycle"
N X1,X2
K ^XTMP("PRCA219P",$J)
S X1=DT,X2=90 D C^%DTC
S ^XTMP("PRCA219P",$J,0)=X_"^"_DT_"^LIKELY BILLS TO PRINT"
I $$DEVICE() D ENTER
Q
;
ENTER ;
;
D BILLFIND
D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
K ^XTMP("PRCA219P",$J)
Q
DEVICE() ;
;Description: allows the user to select a device.
;
;Output:
; Function Value - Returns 0 if the user decides not to print or to
; queue the report, 1 otherwise.
;
N OK,IOP,POP,%ZIS
S OK=1
S %ZIS="MQ"
D ^%ZIS
S:POP OK=0
D:OK&$D(IO("Q"))
.N ZTRTN,ZTDESC,ZTSKM,ZTREQ,ZTSTOP
.S ZTRTN="BILLFIND^PRCA219P",ZTDESC="Likely Bills to Print"
.D ^%ZTLOAD
.W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
.D HOME^%ZIS
.S OK=0
Q OK
;
BILLFIND ;
; Find older bills that will most likely print next cycle after *219 installed
; Categories are: Adult Day Health Care, C(Means Test), Geriatric Eval-Institutional, Geriatric Eval-Non-Institutional,
; Respite Care-Institutional, Respite Care-Non-Institional, RX Co-Payment/SC Vet, RX Co-Payment/NSC Vet, Hospital Care (NSC),
; Hospital Care Per Diem, Nursing Home Care Per Diem, Nursing Home Care (NSC), Nursing Home Care-LTC, Outpatient Care (NSC),
; Current Employee, Emergency/Humanitarian, Ineligible Hospital, Ex-Employee, Vendor, ChampVA Subsistence, Tricare Patient
;
N BILLDFN,CAT,LETTER2,LETTER3,CURBAL,PNAME,Z,X,Y,I,COUNT
S COUNT=0,BILLDFN=0
F S BILLDFN=$O(^PRCA(430,"AC",16,BILLDFN)) Q:'BILLDFN D
. S Z=$S($D(^PRCA(430,BILLDFN,7)):^(7),1:"") S Y=$P(Z,"^",1)+$P(Z,"^",2)+$P(Z,"^",3)+$P(Z,"^",4)+$P(Z,"^",5)
. S CURBAL=$J(Y,0,2) Q:CURBAL'>0
. S LETTER2=$P($G(^PRCA(430,BILLDFN,6)),"^",2) Q:LETTER2=""
. S %H=+$H-30 D YMD^%DTC Q:LETTER2>X
. S LETTER3=$P($G(^PRCA(430,BILLDFN,6)),"^",3) Q:LETTER3'=""
. S CAT=$P(^PRCA(430,BILLDFN,0),"^",2),CAT=","_CAT_","
. S I=",33,18,37,38,35,36,23,22,5,25,24,3,39,4,"
. I I'[CAT Q
. S CAT=$TR(CAT,",","")
. S ^XTMP("PRCA219P",$J,CAT,BILLDFN)=$P(^PRCA(430,BILLDFN,0),U,1)
. S COUNT=COUNT+1
;
;
PRINT ;
U IO
N PRCADDT,PRCAQUIT,PRCAPG,BILLNO
S PRCADDT=$$FMTE^XLFDT($$NOW^XLFDT,"D")
S (PRCAQUIT,PRCAPG)=0
D HEAD
I '$G(COUNT) D Q
.W !!!,?20,"*** No bills to report ***"
W !!,"*** COUNT OF LIKELY BILLS TO PRINT "_COUNT," ***",!!
S CAT=0
F S CAT=$O(^XTMP("PRCA219P",$J,CAT)) Q:'CAT!PRCAQUIT S BILLDFN=0 D
. F S BILLDFN=$O(^XTMP("PRCA219P",$J,CAT,BILLDFN)) Q:'BILLDFN D Q:PRCAQUIT
. . I $Y>(IOSL-4) D HEAD
. . S BILLNO=$P($G(^XTMP("PRCA219P",$J,CAT,BILLDFN)),U)
. . W !,?2,$P(^PRCA(430.2,CAT,0),U,1),?25,BILLNO
;
I PRCAQUIT W:$D(ZTQUEUED) !!,"Report stopped at user's request" Q
I $G(PRCAPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 PRCAQUIT=1
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
HEAD ;
I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,PRCAQUIT)=1 Q
I $G(PRCAPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 PRCAQUIT=1
Q:PRCAQUIT
S PRCAPG=$G(PRCAPG)+1
W @IOF,!,PRCADDT,?15,"PRCA*4.5*219 Older Bills Most Likely to Print",?70,"Page:",$J(PRCAPG,5),! K X S $P(X,"-",81)="" W X,!
W !
W !,?2,"Category",?25,"Bill Number",!
S $P(X,"-",81)="" W X,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCA219P 3395 printed Nov 22, 2024@16:48:51 Page 2
PRCA219P ;ALB/RRG - REPORT LIKELY BILLS TO PRINT;;
+1 ;;4.5;Accounts Receivable;**219**;Mar 20, 1995;Build 18
+2 QUIT
+3 ;
REPORT ;
+1 ;
+2 WRITE !,"This is a report of older bills that will likely print at the next print cycle"
+3 NEW X1,X2
+4 KILL ^XTMP("PRCA219P",$JOB)
+5 SET X1=DT
SET X2=90
DO C^%DTC
+6 SET ^XTMP("PRCA219P",$JOB,0)=X_"^"_DT_"^LIKELY BILLS TO PRINT"
+7 IF $$DEVICE()
DO ENTER
+8 QUIT
+9 ;
ENTER ;
+1 ;
+2 DO BILLFIND
+3 DO ^%ZISC
+4 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 KILL ^XTMP("PRCA219P",$JOB)
+6 QUIT
DEVICE() ;
+1 ;Description: allows the user to select a device.
+2 ;
+3 ;Output:
+4 ; Function Value - Returns 0 if the user decides not to print or to
+5 ; queue the report, 1 otherwise.
+6 ;
+7 NEW OK,IOP,POP,%ZIS
+8 SET OK=1
+9 SET %ZIS="MQ"
+10 DO ^%ZIS
+11 if POP
SET OK=0
+12 if OK&$DATA(IO("Q"))
Begin DoDot:1
+13 NEW ZTRTN,ZTDESC,ZTSKM,ZTREQ,ZTSTOP
+14 SET ZTRTN="BILLFIND^PRCA219P"
SET ZTDESC="Likely Bills to Print"
+15 DO ^%ZTLOAD
+16 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+17 DO HOME^%ZIS
+18 SET OK=0
End DoDot:1
+19 QUIT OK
+20 ;
BILLFIND ;
+1 ; Find older bills that will most likely print next cycle after *219 installed
+2 ; Categories are: Adult Day Health Care, C(Means Test), Geriatric Eval-Institutional, Geriatric Eval-Non-Institutional,
+3 ; Respite Care-Institutional, Respite Care-Non-Institional, RX Co-Payment/SC Vet, RX Co-Payment/NSC Vet, Hospital Care (NSC),
+4 ; Hospital Care Per Diem, Nursing Home Care Per Diem, Nursing Home Care (NSC), Nursing Home Care-LTC, Outpatient Care (NSC),
+5 ; Current Employee, Emergency/Humanitarian, Ineligible Hospital, Ex-Employee, Vendor, ChampVA Subsistence, Tricare Patient
+6 ;
+7 NEW BILLDFN,CAT,LETTER2,LETTER3,CURBAL,PNAME,Z,X,Y,I,COUNT
+8 SET COUNT=0
SET BILLDFN=0
+9 FOR
SET BILLDFN=$ORDER(^PRCA(430,"AC",16,BILLDFN))
if 'BILLDFN
QUIT
Begin DoDot:1
+10 SET Z=$SELECT($DATA(^PRCA(430,BILLDFN,7)):^(7),1:"")
SET Y=$PIECE(Z,"^",1)+$PIECE(Z,"^",2)+$PIECE(Z,"^",3)+$PIECE(Z,"^",4)+$PIECE(Z,"^",5)
+11 SET CURBAL=$JUSTIFY(Y,0,2)
if CURBAL'>0
QUIT
+12 SET LETTER2=$PIECE($GET(^PRCA(430,BILLDFN,6)),"^",2)
if LETTER2=""
QUIT
+13 SET %H=+$HOROLOG-30
DO YMD^%DTC
if LETTER2>X
QUIT
+14 SET LETTER3=$PIECE($GET(^PRCA(430,BILLDFN,6)),"^",3)
if LETTER3'=""
QUIT
+15 SET CAT=$PIECE(^PRCA(430,BILLDFN,0),"^",2)
SET CAT=","_CAT_","
+16 SET I=",33,18,37,38,35,36,23,22,5,25,24,3,39,4,"
+17 IF I'[CAT
QUIT
+18 SET CAT=$TRANSLATE(CAT,",","")
+19 SET ^XTMP("PRCA219P",$JOB,CAT,BILLDFN)=$PIECE(^PRCA(430,BILLDFN,0),U,1)
+20 SET COUNT=COUNT+1
End DoDot:1
+21 ;
+22 ;
PRINT ;
+1 USE IO
+2 NEW PRCADDT,PRCAQUIT,PRCAPG,BILLNO
+3 SET PRCADDT=$$FMTE^XLFDT($$NOW^XLFDT,"D")
+4 SET (PRCAQUIT,PRCAPG)=0
+5 DO HEAD
+6 IF '$GET(COUNT)
Begin DoDot:1
+7 WRITE !!!,?20,"*** No bills to report ***"
End DoDot:1
QUIT
+8 WRITE !!,"*** COUNT OF LIKELY BILLS TO PRINT "_COUNT," ***",!!
+9 SET CAT=0
+10 FOR
SET CAT=$ORDER(^XTMP("PRCA219P",$JOB,CAT))
if 'CAT!PRCAQUIT
QUIT
SET BILLDFN=0
Begin DoDot:1
+11 FOR
SET BILLDFN=$ORDER(^XTMP("PRCA219P",$JOB,CAT,BILLDFN))
if 'BILLDFN
QUIT
Begin DoDot:2
+12 IF $Y>(IOSL-4)
DO HEAD
+13 SET BILLNO=$PIECE($GET(^XTMP("PRCA219P",$JOB,CAT,BILLDFN)),U)
+14 WRITE !,?2,$PIECE(^PRCA(430.2,CAT,0),U,1),?25,BILLNO
End DoDot:2
if PRCAQUIT
QUIT
End DoDot:1
+15 ;
+16 IF PRCAQUIT
if $DATA(ZTQUEUED)
WRITE !!,"Report stopped at user's request"
QUIT
+17 IF $GET(PRCAPG)>0
IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
if +Y=0
SET PRCAQUIT=1
+18 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+19 QUIT
+20 ;
HEAD ;
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (ZTSTOP,PRCAQUIT)=1
QUIT
+2 IF $GET(PRCAPG)>0
IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
if +Y=0
SET PRCAQUIT=1
+3 if PRCAQUIT
QUIT
+4 SET PRCAPG=$GET(PRCAPG)+1
+5 WRITE @IOF,!,PRCADDT,?15,"PRCA*4.5*219 Older Bills Most Likely to Print",?70,"Page:",$JUSTIFY(PRCAPG,5),!
KILL X
SET $PIECE(X,"-",81)=""
WRITE X,!
+6 WRITE !
+7 WRITE !,?2,"Category",?25,"Bill Number",!
+8 SET $PIECE(X,"-",81)=""
WRITE X,!
+9 QUIT
