BARDMRS ;IHS/OIT/FCJ - DEBT MANAGEMENT STATUS REPORT
;;1.8;IHS ACCOUNTS RECEIVABLE;**22**;OCT 26, 2005;Build 38
;New routine 5-12-2011 for Debt Letter Management
;
;PRINT status of Debt Management Bill
;
ST ;
W !,"Print comments for Bill which status was changed by someone"
D SEL
G:+Y<1 XIT
D PRT
Q
XIT ;
K DIC,DIE,DR,DA
;K L,L1,L2,L3 ;bar*1.8*22 SDR
K BARL,BARL1,BARL2,BARL3 ;bar*1.8*22 SDR
Q
;
SEL ;SELECT and EDIT DM BILL
S BARREQ=0
S (DIE,DIC)="^BARDM("_DUZ(2)_","
S DIC("A")="Enter the Debt Management Bill: "
S DIC(0)="AEQ"
D ^DIC
Q:+Y<1
S BARDM=+Y
Q
PRT ;
S BARBILN=$$VAL^XBDIQ1(90053.05,BARDM,.01)
S BARST=$$VAL^XBDIQ1(90053.05,BARDM,.02)
W @IOF,! F I=1:1:80 W "*"
W !,"Bill Number: ",BARBILN,?40,"Current Bill Status: ",BARST,!
F I=1:1:80 W "*"
;start old code bar*1.8*22 SDR
;S L=0
;F S L=$O(^BARDM(DUZ(2),BARDM,50,L)) Q:L'?1N.N D Q:$G(BARDLQ)
;.S Y=$P(^BARDM(DUZ(2),BARDM,50,L,0),U) D DD^%DT S BARDT=Y
;.S BARUSR=$$VAL^XBDIQ1(200,$P(^BARDM(DUZ(2),BARDM,50,L,0),U,2),.01)
;.S BARST1=$P(^BARDM(DUZ(2),BARDM,50,L,0),U,3)
;.I $Y>(IOSL-6) D RTRN^BARDMU Q:$G(BARDLQ) W @IOF
;.W !,"Comment Date: ",BARDT,?30,"Status: ",BARST1,?45,"Changed by: ",BARUSR
;.W !,"Comments:"
;.K ^UTILITY($J,"W") S DIWL=3,DIWR=75
;.S L1=0 F S L1=$O(^BARDM(DUZ(2),BARDM,50,L,L1)) Q:L1'?1N.N D
;..S L2=0 F S L2=$O(^BARDM(DUZ(2),BARDM,50,L,L1,L2)) Q:L2'?1N.N D
;...S X=^BARDM(DUZ(2),BARDM,50,L,L1,L2,0) D ^DIWP
;.S X="" D ^DIWP,^DIWW
;end old code start new code
S BARL=0
F S BARL=$O(^BARDM(DUZ(2),BARDM,50,BARL)) Q:BARL'?1N.N D Q:$G(BARDLQ)
.S Y=$P(^BARDM(DUZ(2),BARDM,50,BARL,0),U) D DD^%DT S BARDT=Y
.S BARUSR=$$VAL^XBDIQ1(200,$P(^BARDM(DUZ(2),BARDM,50,BARL,0),U,2),.01)
.S BARST1=$P(^BARDM(DUZ(2),BARDM,50,BARL,0),U,3)
.I $Y>(IOSL-6) D RTRN^BARDMU Q:$G(BARDLQ) W @IOF
.W !,"Comment DT/TM: ",BARDT,?38,"Status: ",BARST1,?49,"Changed by: ",BARUSR ;bar*1.8*22 SDR
.W !,"Comments:"
.K ^UTILITY($J,"W") S DIWL=3,DIWR=75
.S BARL1=0 F S BARL1=$O(^BARDM(DUZ(2),BARDM,50,BARL,BARL1)) Q:BARL1'?1N.N D
..S BARL2=0 F S BARL2=$O(^BARDM(DUZ(2),BARDM,50,BARL,BARL1,BARL2)) Q:BARL2'?1N.N D
...S X=^BARDM(DUZ(2),BARDM,50,BARL,BARL1,BARL2,0) D ^DIWP
.S X="" D ^DIWP,^DIWW
;end new code
D:'$G(BARDLQ) RTRN^BARDMU
Q
BARDMRS ;IHS/OIT/FCJ - DEBT MANAGEMENT STATUS REPORT
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**22**;OCT 26, 2005;Build 38
+2 ;New routine 5-12-2011 for Debt Letter Management
+3 ;
+4 ;PRINT status of Debt Management Bill
+5 ;
ST ;
+1 WRITE !,"Print comments for Bill which status was changed by someone"
+2 DO SEL
+3 IF +Y<1
GOTO XIT
+4 DO PRT
+5 QUIT
XIT ;
+1 KILL DIC,DIE,DR,DA
+2 ;K L,L1,L2,L3 ;bar*1.8*22 SDR
+3 ;bar*1.8*22 SDR
KILL BARL,BARL1,BARL2,BARL3
+4 QUIT
+5 ;
SEL ;SELECT and EDIT DM BILL
+1 SET BARREQ=0
+2 SET (DIE,DIC)="^BARDM("_DUZ(2)_","
+3 SET DIC("A")="Enter the Debt Management Bill: "
+4 SET DIC(0)="AEQ"
+5 DO ^DIC
+6 IF +Y<1
QUIT
+7 SET BARDM=+Y
+8 QUIT
PRT ;
+1 SET BARBILN=$$VAL^XBDIQ1(90053.05,BARDM,.01)
+2 SET BARST=$$VAL^XBDIQ1(90053.05,BARDM,.02)
+3 WRITE @IOF,!
FOR I=1:1:80
WRITE "*"
+4 WRITE !,"Bill Number: ",BARBILN,?40,"Current Bill Status: ",BARST,!
+5 FOR I=1:1:80
WRITE "*"
+6 ;start old code bar*1.8*22 SDR
+7 ;S L=0
+8 ;F S L=$O(^BARDM(DUZ(2),BARDM,50,L)) Q:L'?1N.N D Q:$G(BARDLQ)
+9 ;.S Y=$P(^BARDM(DUZ(2),BARDM,50,L,0),U) D DD^%DT S BARDT=Y
+10 ;.S BARUSR=$$VAL^XBDIQ1(200,$P(^BARDM(DUZ(2),BARDM,50,L,0),U,2),.01)
+11 ;.S BARST1=$P(^BARDM(DUZ(2),BARDM,50,L,0),U,3)
+12 ;.I $Y>(IOSL-6) D RTRN^BARDMU Q:$G(BARDLQ) W @IOF
+13 ;.W !,"Comment Date: ",BARDT,?30,"Status: ",BARST1,?45,"Changed by: ",BARUSR
+14 ;.W !,"Comments:"
+15 ;.K ^UTILITY($J,"W") S DIWL=3,DIWR=75
+16 ;.S L1=0 F S L1=$O(^BARDM(DUZ(2),BARDM,50,L,L1)) Q:L1'?1N.N D
+17 ;..S L2=0 F S L2=$O(^BARDM(DUZ(2),BARDM,50,L,L1,L2)) Q:L2'?1N.N D
+18 ;...S X=^BARDM(DUZ(2),BARDM,50,L,L1,L2,0) D ^DIWP
+19 ;.S X="" D ^DIWP,^DIWW
+20 ;end old code start new code
+21 SET BARL=0
+22 FOR
SET BARL=$ORDER(^BARDM(DUZ(2),BARDM,50,BARL))
IF BARL'?1N.N
QUIT
Begin DoDot:1
+23 SET Y=$PIECE(^BARDM(DUZ(2),BARDM,50,BARL,0),U)
DO DD^%DT
SET BARDT=Y
+24 SET BARUSR=$$VAL^XBDIQ1(200,$PIECE(^BARDM(DUZ(2),BARDM,50,BARL,0),U,2),.01)
+25 SET BARST1=$PIECE(^BARDM(DUZ(2),BARDM,50,BARL,0),U,3)
+26 IF $Y>(IOSL-6)
DO RTRN^BARDMU
IF $GET(BARDLQ)
QUIT
WRITE @IOF
+27 ;bar*1.8*22 SDR
WRITE !,"Comment DT/TM: ",BARDT,?38,"Status: ",BARST1,?49,"Changed by: ",BARUSR
+28 WRITE !,"Comments:"
+29 KILL ^UTILITY($JOB,"W")
SET DIWL=3
SET DIWR=75
+30 SET BARL1=0
FOR
SET BARL1=$ORDER(^BARDM(DUZ(2),BARDM,50,BARL,BARL1))
IF BARL1'?1N.N
QUIT
Begin DoDot:2
+31 SET BARL2=0
FOR
SET BARL2=$ORDER(^BARDM(DUZ(2),BARDM,50,BARL,BARL1,BARL2))
IF BARL2'?1N.N
QUIT
Begin DoDot:3
+32 SET X=^BARDM(DUZ(2),BARDM,50,BARL,BARL1,BARL2,0)
DO ^DIWP
End DoDot:3
End DoDot:2
+33 SET X=""
DO ^DIWP
DO ^DIWW
End DoDot:1
IF $GET(BARDLQ)
QUIT
+34 ;end new code
+35 IF '$GET(BARDLQ)
DO RTRN^BARDMU
+36 QUIT
