BARPST6 ; IHS/SD/LSL - MESSAGE PROCESSOR ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;
; IHS/SD/LSL - 11/26/02 - V1.7 - QAA-1200-130051
; Modified to quit if error in creating an A/R Transaction
;
; ********************************************************************
;** Message processor for accounts,patients and bills
;
EN(BARPAT,BARBIL,BARACC) ;EP - message processor
1 ;
S:'$D(BARPAT) BARPAT=""
S:'$D(BARBIL) BARBIL=""
S:'$D(BARACC) BARACC=""
;
N BARMTYP,BARM,BAR1,BAR2,BAR3,BAR4
EN1 ;
D CENTER("Message Processor")
F J=4:1:6 S BARM(J)=""
EN2 ;
W !
I BARPAT S BARM(5)=$$GET1^DIQ(2,BARPAT,.01)
I BARBIL S BARM(4)=$$GET1^DIQ(90050.01,BARBIL,.01)
I BARACC S BARM(6)=$$GET1^DIQ(90050.02,BARACC,.01)
S BAR1=$S($L(BARM(4)):"1:BILL MESSAGE for bill "_BARM(4),1:"1:No Bill defined.")
S BAR2=$S($L(BARM(5)):"2:PATIENT MESSAGE for patient "_BARM(5),1:"2:No patient defined.")
S BAR3=$S($L(BARM(6)):"3:ACCOUNT MESSAGE for account "_BARM(6),1:"3:No account defined.")
S BAR4="4:EXIT"
S DIR(0)="SO^"_BAR1_";"_BAR2_";"_BAR3_";"_BAR4
S DIR("A")="Select Message Level"
S DIR("?")="^W *7 D CENTER^BARPST6(""Message Processor"")"
D ^DIR
K DIR
Q:$D(DUOUT)!(+Y=0)!(Y=4)
S BARMTYP=Y
S BARY=BARMTYP+3
I '$L(BARM(BARY)) W *7,"??" H 5 G EN1
D VIEW
D TX
G EN1
; *********************************************************************
;
VIEW ;
N BARCNT,BARXRF,BARBX,BARTRDA,BARTRD1
S BARBX=$S(BARMTYP=1:BARBIL,BARMTYP=2:BARPAT,BARMTYP=3:BARACC,1:"")
S BARXRF="AM"_BARY
W !!
I '$D(^BARTR(DUZ(2),BARXRF,BARBX)) D Q
.W *7,!!!,"No Messages on file!"
.D EOP^BARUTL(1)
.Q
S DIR("A")="View existing Messages (Y/N): "
S DIR("B")="NO"
S DIR(0)="YOA"
D ^DIR
K DIR
I Y=0!($D(DUOUT)) Q
D VIEWR^XBLM("VIEW2^BARPST6","Message Display for "_BARM(BARY))
G VIEW3
; *********************************************************************
;
VIEW2 ;
W $$EN^BARVDF("IOF"),!
K ^UTILITY($J,"W")
S DIWL=15,DIWR=77,DIWF="W"
S (BARSTOP,BARCNT)=0
S BARTRDA="A"
F S BARTRDA=$O(^BARTR(DUZ(2),BARXRF,BARBX,BARTRDA),-1) Q:'BARTRDA D Q:BARSTOP
. W !,$$GET1^DIQ(90050.03,BARTRDA,12)
. S BARTRD1=0
. F S BARTRD1=$O(^BARTR(DUZ(2),BARTRDA,10,BARTRD1)) Q:'BARTRD1 D Q:BARSTOP
.. S BARCNT=BARCNT+1
.. S X=^BARTR(DUZ(2),BARTRDA,10,BARTRD1,0)
.. D ^DIWP
.. S BARSTOP=0
. D ^DIWW
K ^UTILITY($J,"W")
I 'BARCNT W *7,!!!,"No Messages on File!"
Q:BARSTOP
Q
; *********************************************************************
;
VIEW3 ;
D EOP^BARUTL(1)
Q
; *********************************************************************
;
TX ;
W $$EN^BARVDF("IOF"),!
D CENTER("Create NEW Message for "_BARM(BARY))
W !!
S DIR("A")="Create a NEW Message (Y/N): "
S DIR("B")="YES"
S DIR(0)="YOA"
D ^DIR
K DIR
I Y=0!($D(DUOUT)) Q
; -------------------------------
;
T1 ;
S X=$$NEW^BARTR
Q:X<1
S DA=X
S DIE="^BARTR(DUZ(2),"
S DR="12////^S X=DT"
S DR=DR_";13////^S X=DUZ"
S DR=DR_";7////^S X=1;QUIT;S Y=BARY"
S DR=DR_";4////^S X=BARBIL;S Y=1001"
S DR=DR_";5////^S X=BARPAT;S Y=1001"
S DR=DR_";6////^S X=BARACC;1001"
S DR=DR_";10////^S X=$$VALI^XBDIQ1(200,DUZ,29)"
S DIDEL=90050
D ^DIE
K DIDEL
Q
; *********************************************************************
;
CENTER(X) ;
W $$EN^BARVDF("IOF"),!
W ?IOM-$L(X)\2,X,!
W ?IOM-$L(X)\2 F J=1:1:$L(X) W "-"
W !
Q
; *********************************************************************
;
CHKLINE() ;
; Q 0 = CONTINUE
; Q 1 = STOP
N X
I ($Y+4)<IOSL Q 0
W !?(IOM-15),"continued==>"
D EOP^BARUTL(0)
I 'Y Q 1
D CENTER("Message Display for "_BARM(BARY)_" (continued)")
W !!
Q 0
BARPST6 ; IHS/SD/LSL - MESSAGE PROCESSOR ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;
+3 ; IHS/SD/LSL - 11/26/02 - V1.7 - QAA-1200-130051
+4 ; Modified to quit if error in creating an A/R Transaction
+5 ;
+6 ; ********************************************************************
+7 ;** Message processor for accounts,patients and bills
+8 ;
EN(BARPAT,BARBIL,BARACC) ;EP - message processor
1 ;
+1 IF '$DATA(BARPAT)
SET BARPAT=""
+2 IF '$DATA(BARBIL)
SET BARBIL=""
+3 IF '$DATA(BARACC)
SET BARACC=""
+4 ;
+5 NEW BARMTYP,BARM,BAR1,BAR2,BAR3,BAR4
EN1 ;
+1 DO CENTER("Message Processor")
+2 FOR J=4:1:6
SET BARM(J)=""
EN2 ;
+1 WRITE !
+2 IF BARPAT
SET BARM(5)=$$GET1^DIQ(2,BARPAT,.01)
+3 IF BARBIL
SET BARM(4)=$$GET1^DIQ(90050.01,BARBIL,.01)
+4 IF BARACC
SET BARM(6)=$$GET1^DIQ(90050.02,BARACC,.01)
+5 SET BAR1=$SELECT($LENGTH(BARM(4)):"1:BILL MESSAGE for bill "_BARM(4),1:"1:No Bill defined.")
+6 SET BAR2=$SELECT($LENGTH(BARM(5)):"2:PATIENT MESSAGE for patient "_BARM(5),1:"2:No patient defined.")
+7 SET BAR3=$SELECT($LENGTH(BARM(6)):"3:ACCOUNT MESSAGE for account "_BARM(6),1:"3:No account defined.")
+8 SET BAR4="4:EXIT"
+9 SET DIR(0)="SO^"_BAR1_";"_BAR2_";"_BAR3_";"_BAR4
+10 SET DIR("A")="Select Message Level"
+11 SET DIR("?")="^W *7 D CENTER^BARPST6(""Message Processor"")"
+12 DO ^DIR
+13 KILL DIR
+14 IF $DATA(DUOUT)!(+Y=0)!(Y=4)
QUIT
+15 SET BARMTYP=Y
+16 SET BARY=BARMTYP+3
+17 IF '$LENGTH(BARM(BARY))
WRITE *7,"??"
HANG 5
GOTO EN1
+18 DO VIEW
+19 DO TX
+20 GOTO EN1
+21 ; *********************************************************************
+22 ;
VIEW ;
+1 NEW BARCNT,BARXRF,BARBX,BARTRDA,BARTRD1
+2 SET BARBX=$SELECT(BARMTYP=1:BARBIL,BARMTYP=2:BARPAT,BARMTYP=3:BARACC,1:"")
+3 SET BARXRF="AM"_BARY
+4 WRITE !!
+5 IF '$DATA(^BARTR(DUZ(2),BARXRF,BARBX))
Begin DoDot:1
+6 WRITE *7,!!!,"No Messages on file!"
+7 DO EOP^BARUTL(1)
+8 QUIT
End DoDot:1
QUIT
+9 SET DIR("A")="View existing Messages (Y/N): "
+10 SET DIR("B")="NO"
+11 SET DIR(0)="YOA"
+12 DO ^DIR
+13 KILL DIR
+14 IF Y=0!($DATA(DUOUT))
QUIT
+15 DO VIEWR^XBLM("VIEW2^BARPST6","Message Display for "_BARM(BARY))
+16 GOTO VIEW3
+17 ; *********************************************************************
+18 ;
VIEW2 ;
+1 WRITE $$EN^BARVDF("IOF"),!
+2 KILL ^UTILITY($JOB,"W")
+3 SET DIWL=15
SET DIWR=77
SET DIWF="W"
+4 SET (BARSTOP,BARCNT)=0
+5 SET BARTRDA="A"
+6 FOR
SET BARTRDA=$ORDER(^BARTR(DUZ(2),BARXRF,BARBX,BARTRDA),-1)
IF 'BARTRDA
QUIT
Begin DoDot:1
+7 WRITE !,$$GET1^DIQ(90050.03,BARTRDA,12)
+8 SET BARTRD1=0
+9 FOR
SET BARTRD1=$ORDER(^BARTR(DUZ(2),BARTRDA,10,BARTRD1))
IF 'BARTRD1
QUIT
Begin DoDot:2
+10 SET BARCNT=BARCNT+1
+11 SET X=^BARTR(DUZ(2),BARTRDA,10,BARTRD1,0)
+12 DO ^DIWP
+13 SET BARSTOP=0
End DoDot:2
IF BARSTOP
QUIT
+14 DO ^DIWW
End DoDot:1
IF BARSTOP
QUIT
+15 KILL ^UTILITY($JOB,"W")
+16 IF 'BARCNT
WRITE *7,!!!,"No Messages on File!"
+17 IF BARSTOP
QUIT
+18 QUIT
+19 ; *********************************************************************
+20 ;
VIEW3 ;
+1 DO EOP^BARUTL(1)
+2 QUIT
+3 ; *********************************************************************
+4 ;
TX ;
+1 WRITE $$EN^BARVDF("IOF"),!
+2 DO CENTER("Create NEW Message for "_BARM(BARY))
+3 WRITE !!
+4 SET DIR("A")="Create a NEW Message (Y/N): "
+5 SET DIR("B")="YES"
+6 SET DIR(0)="YOA"
+7 DO ^DIR
+8 KILL DIR
+9 IF Y=0!($DATA(DUOUT))
QUIT
+10 ; -------------------------------
+11 ;
T1 ;
+1 SET X=$$NEW^BARTR
+2 IF X<1
QUIT
+3 SET DA=X
+4 SET DIE="^BARTR(DUZ(2),"
+5 SET DR="12////^S X=DT"
+6 SET DR=DR_";13////^S X=DUZ"
+7 SET DR=DR_";7////^S X=1;QUIT;S Y=BARY"
+8 SET DR=DR_";4////^S X=BARBIL;S Y=1001"
+9 SET DR=DR_";5////^S X=BARPAT;S Y=1001"
+10 SET DR=DR_";6////^S X=BARACC;1001"
+11 SET DR=DR_";10////^S X=$$VALI^XBDIQ1(200,DUZ,29)"
+12 SET DIDEL=90050
+13 DO ^DIE
+14 KILL DIDEL
+15 QUIT
+16 ; *********************************************************************
+17 ;
CENTER(X) ;
+1 WRITE $$EN^BARVDF("IOF"),!
+2 WRITE ?IOM-$LENGTH(X)\2,X,!
+3 WRITE ?IOM-$LENGTH(X)\2
FOR J=1:1:$LENGTH(X)
WRITE "-"
+4 WRITE !
+5 QUIT
+6 ; *********************************************************************
+7 ;
CHKLINE() ;
+1 ; Q 0 = CONTINUE
+2 ; Q 1 = STOP
+3 NEW X
+4 IF ($Y+4)<IOSL
QUIT 0
+5 WRITE !?(IOM-15),"continued==>"
+6 DO EOP^BARUTL(0)
+7 IF 'Y
QUIT 1
+8 DO CENTER("Message Display for "_BARM(BARY)_" (continued)")
+9 WRITE !!
+10 QUIT 0
