Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARDMRS

BARDMRS.m

Go to the documentation of this file. 
  1. BARDMRS ;IHS/OIT/FCJ - DEBT MANAGEMENT STATUS REPORT
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**22**;OCT 26, 2005;Build 38
  1.  ;New routine 5-12-2011 for Debt Letter Management
  1.  ;
  1.  ;PRINT status of Debt Management Bill
  1.  ;
  1. ST ;
  1.  W !,"Print comments for Bill which status was changed by someone"
  1.  D SEL
  1.  G:+Y<1 XIT
  1.  D PRT
  1.  Q
  1. XIT ;
  1.  K DIC,DIE,DR,DA
  1.  ;K L,L1,L2,L3  ;bar*1.8*22 SDR
  1.  K BARL,BARL1,BARL2,BARL3  ;bar*1.8*22 SDR
  1.  Q
  1.  ;
  1. SEL ;SELECT and EDIT DM BILL
  1.  S BARREQ=0
  1.  S (DIE,DIC)="^BARDM("_DUZ(2)_","
  1.  S DIC("A")="Enter the Debt Management Bill: "
  1.  S DIC(0)="AEQ"
  1.  D ^DIC
  1.  Q:+Y<1
  1.  S BARDM=+Y
  1.  Q
  1. PRT ;
  1.  S BARBILN=$$VAL^XBDIQ1(90053.05,BARDM,.01)
  1.  S BARST=$$VAL^XBDIQ1(90053.05,BARDM,.02)
  1.  W @IOF,! F I=1:1:80 W "*"
  1.  W !,"Bill Number: ",BARBILN,?40,"Current Bill Status: ",BARST,!
  1.  F I=1:1:80 W "*"
  1.  ;start old code bar*1.8*22 SDR
  1.  ;S L=0
  1.  ;F  S L=$O(^BARDM(DUZ(2),BARDM,50,L)) Q:L'?1N.N  D  Q:$G(BARDLQ)
  1.  ;.S Y=$P(^BARDM(DUZ(2),BARDM,50,L,0),U) D DD^%DT S BARDT=Y
  1.  ;.S BARUSR=$$VAL^XBDIQ1(200,$P(^BARDM(DUZ(2),BARDM,50,L,0),U,2),.01)
  1.  ;.S BARST1=$P(^BARDM(DUZ(2),BARDM,50,L,0),U,3)
  1.  ;.I $Y>(IOSL-6) D RTRN^BARDMU Q:$G(BARDLQ)  W @IOF
  1.  ;.W !,"Comment Date: ",BARDT,?30,"Status: ",BARST1,?45,"Changed by: ",BARUSR
  1.  ;.W !,"Comments:"
  1.  ;.K ^UTILITY($J,"W") S DIWL=3,DIWR=75
  1.  ;.S L1=0 F  S L1=$O(^BARDM(DUZ(2),BARDM,50,L,L1)) Q:L1'?1N.N  D
  1.  ;..S L2=0 F  S L2=$O(^BARDM(DUZ(2),BARDM,50,L,L1,L2)) Q:L2'?1N.N  D
  1.  ;...S X=^BARDM(DUZ(2),BARDM,50,L,L1,L2,0) D ^DIWP
  1.  ;.S X="" D ^DIWP,^DIWW
  1.  ;end old code start new code
  1.  S BARL=0
  1.  F  S BARL=$O(^BARDM(DUZ(2),BARDM,50,BARL)) Q:BARL'?1N.N  D  Q:$G(BARDLQ)
  1.  .S Y=$P(^BARDM(DUZ(2),BARDM,50,BARL,0),U) D DD^%DT S BARDT=Y
  1.  .S BARUSR=$$VAL^XBDIQ1(200,$P(^BARDM(DUZ(2),BARDM,50,BARL,0),U,2),.01)
  1.  .S BARST1=$P(^BARDM(DUZ(2),BARDM,50,BARL,0),U,3)
  1.  .I $Y>(IOSL-6) D RTRN^BARDMU Q:$G(BARDLQ)  W @IOF
  1.  .W !,"Comment DT/TM: ",BARDT,?38,"Status: ",BARST1,?49,"Changed by: ",BARUSR  ;bar*1.8*22 SDR
  1.  .W !,"Comments:"
  1.  .K ^UTILITY($J,"W") S DIWL=3,DIWR=75
  1.  .S BARL1=0 F  S BARL1=$O(^BARDM(DUZ(2),BARDM,50,BARL,BARL1)) Q:BARL1'?1N.N  D
  1.  ..S BARL2=0 F  S BARL2=$O(^BARDM(DUZ(2),BARDM,50,BARL,BARL1,BARL2)) Q:BARL2'?1N.N  D
  1.  ...S X=^BARDM(DUZ(2),BARDM,50,BARL,BARL1,BARL2,0) D ^DIWP
  1.  .S X="" D ^DIWP,^DIWW
  1.  ;end new code
  1.  D:'$G(BARDLQ) RTRN^BARDMU
  1.  Q