BARDMST.m

BARDMST ;IHS/OIT/FCJ - DEBT MANAGEMENT STATUS EDIT

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**22**;OCT 26, 2005;Build 38

 ;New routine 5-12-2011 for Debt Letter Management

 ;

 ;Edit status of Debt Management Bills for printing letters

 ;

ST ;

 W !,"Edit status of Debt Management Bills for printing letters"

 W !,"If status changes to Suspended you must enter a comment.",!!

 D SEL

 G:BARQ XIT

 D:BARST'=BARST1 COM,LETST

 G XIT

 Q

XIT ;

 K DIC,DIE,DR,DA

 Q

 ;

SEL ;SELECT and EDIT DM BILL

 D SEL^BARDMU

 Q:BARQ=1

 ;Test for comments

 S L=0 F  S L=$O(^BARDM(DUZ(2),BARDM,50,L)) Q:L'?1N.N  D

 .Q:$P(^BARDM(DUZ(2),BARDM,50,L,0),U,3)'="S"

 .W !!,"* This bill has a comment for being previously suspended,"

 .W !,"to review use option: Print the Debt Management Bill Status Comments",!

 S BARST=$P(^BARDM(DUZ(2),BARDM,0),U,2)

 S DA=BARDM,DR=".02"

 D ^DIE

 S BARST1=$P(^BARDM(DUZ(2),BARDM,0),U,2)

 S:(BARST'=BARST1)&(BARST1="S") BARREQ=1

 Q

COM ;

 ;ADD SUB ENTRY

 S DA(1)=BARDM

 ;S DIC="^BARDM("_DUZ(2)_","_BARDM_",50,",DIC(0)="L",X=DT  ;bar*1.8*22 SDR make date/time for comments

 ;start new code bar*1.8*22 SDR

 D NOW^%DTC

 S X=%

 S DIC="^BARDM("_DUZ(2)_","_BARDM_",50,",DIC(0)="L"

 ;end new code bar*1.8*22 SDR

 S DIC("P")=$P(^DD(90053.05,50,0),U,2)

 D FILE^DICN

 S:+Y>0 DA=+Y

 I +Y<0 W !,"ERROR ADDING STATUS COMMENTS ENTRY " Q

 S DIE=DIC

 S DR=".02///"_DUZ_";.03///"_BARST1

 D ^DIE

COM1 ;COMMENT

 S DR=1

 D ^DIE

 ;I BARREQ=1,X="NO" W !,"COMMENT REQUIRED FOR SUSPENDED BILLS" G COM1  ;bar*1.8*22 SDR

 I BARREQ=1,(X="NO"!(X["^")) W !,"COMMENT REQUIRED FOR SUSPENDED BILLS" G COM1  ;bar*1.8*22 SDR

 Q

LETST ;LETTER STATUS

 S BARDMC=0,BARCYL=0

 F  S BARDMC=$O(^BARDM(DUZ(2),BARDM,100,BARDMC)) Q:BARDMC'?1N.N  S BARCYL=BARDMC

 S BARCYST=$S(BARST1="A":"Q",1:"N")

 S (DIC,DIE)="^BARDM(DUZ(2),"_BARDM_",100,",DA(1)=BARDM,DA=BARCYL

 S DR=".03///"_BARCYST

 D ^DIE

 K DIE,DIC,DA

 Q

BARDMST   ;IHS/OIT/FCJ - DEBT MANAGEMENT STATUS EDIT

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**22**;OCT 26, 2005;Build 38

 +2       ;New routine 5-12-2011 for Debt Letter Management

 +3       ;

 +4       ;Edit status of Debt Management Bills for printing letters

 +5       ;

ST        ;

 +1        WRITE !,"Edit status of Debt Management Bills for printing letters"

 +2        WRITE !,"If status changes to Suspended you must enter a comment.",!!

 +3        DO SEL

 +4        IF BARQ

               GOTO XIT

 +5        IF BARST'=BARST1

               DO COM

               DO LETST

 +6        GOTO XIT

 +7        QUIT 

XIT       ;

 +1        KILL DIC,DIE,DR,DA

 +2        QUIT 

 +3       ;

SEL       ;SELECT and EDIT DM BILL

 +1        DO SEL^BARDMU

 +2        IF BARQ=1

               QUIT 

 +3       ;Test for comments

 +4        SET L=0

           FOR 

               SET L=$ORDER(^BARDM(DUZ(2),BARDM,50,L))

               IF L'?1N.N

                   QUIT 

               Begin DoDot:1

 +5                IF $PIECE(^BARDM(DUZ(2),BARDM,50,L,0),U,3)'="S"

                       QUIT 

 +6                WRITE !!,"* This bill has a comment for being previously suspended,"

 +7                WRITE !,"to review use option: Print the Debt Management Bill Status Comments",!

               End DoDot:1

 +8        SET BARST=$PIECE(^BARDM(DUZ(2),BARDM,0),U,2)

 +9        SET DA=BARDM

           SET DR=".02"

 +10       DO ^DIE

 +11       SET BARST1=$PIECE(^BARDM(DUZ(2),BARDM,0),U,2)

 +12       IF (BARST'=BARST1)&(BARST1="S")

               SET BARREQ=1

 +13       QUIT 

COM       ;

 +1       ;ADD SUB ENTRY

 +2        SET DA(1)=BARDM

 +3       ;S DIC="^BARDM("_DUZ(2)_","_BARDM_",50,",DIC(0)="L",X=DT  ;bar*1.8*22 SDR make date/time for comments

 +4       ;start new code bar*1.8*22 SDR

 +5        DO NOW^%DTC

 +6        SET X=%

 +7        SET DIC="^BARDM("_DUZ(2)_","_BARDM_",50,"

           SET DIC(0)="L"

 +8       ;end new code bar*1.8*22 SDR

 +9        SET DIC("P")=$PIECE(^DD(90053.05,50,0),U,2)

 +10       DO FILE^DICN

 +11       IF +Y>0

               SET DA=+Y

 +12       IF +Y<0

               WRITE !,"ERROR ADDING STATUS COMMENTS ENTRY "

               QUIT 

 +13       SET DIE=DIC

 +14       SET DR=".02///"_DUZ_";.03///"_BARST1

 +15       DO ^DIE

COM1      ;COMMENT

 +1        SET DR=1

 +2        DO ^DIE

 +3       ;I BARREQ=1,X="NO" W !,"COMMENT REQUIRED FOR SUSPENDED BILLS" G COM1  ;bar*1.8*22 SDR

 +4       ;bar*1.8*22 SDR

           IF BARREQ=1

               IF (X="NO"!(X["^"))

                   WRITE !,"COMMENT REQUIRED FOR SUSPENDED BILLS"

                   GOTO COM1

 +5        QUIT 

LETST     ;LETTER STATUS

 +1        SET BARDMC=0

           SET BARCYL=0

 +2        FOR 

               SET BARDMC=$ORDER(^BARDM(DUZ(2),BARDM,100,BARDMC))

               IF BARDMC'?1N.N

                   QUIT 

               SET BARCYL=BARDMC

 +3        SET BARCYST=$SELECT(BARST1="A":"Q",1:"N")

 +4        SET (DIC,DIE)="^BARDM(DUZ(2),"_BARDM_",100,"

           SET DA(1)=BARDM

           SET DA=BARCYL

 +5        SET DR=".03///"_BARCYST

 +6        DO ^DIE

 +7        KILL DIE,DIC,DA

 +8        QUIT