Routine: BARPST6

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

 ; *********************************************************************

VIEW3 ;

 D EOP^BARUTL(1)

 ; *********************************************************************

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

 ; *********************************************************************

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 !

 ; *********************************************************************

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

BARPST6.m