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

BARUFLTR.m

Go to the documentation of this file. 
  1. BARUFLTR ; IHS/SD/TPF - UFMS LETTERS ;
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,4,17**;OCT 22, 2008
  1.  Q
  1.  ;
  1.  ;LETTER(BARAMT,BARCOL,BARCHK,BARSCHED,BARINS,BARLTR) ;EP - PRINT LETTER
  1. LETTER(BARAMT,BARCOL,BARCHK,BARSCHED,BARINS,BARLTR,BARRETYP,BARADJT) ;EP - PRINT LETTER ;BAR*1.8*4
  1.  S BARSAVE=1
  1. LETTER1 ;EP -
  1.  S Y=DT X ^DD("DD")
  1.  S BAREXNOW=Y
  1.  ;S BARDUZ=DUZ
  1.  ;S BARDUZ2=DUZ(2)
  1.  S:'$G(BARDUZ) BARDUZ=DUZ      ;BAR*1.8*4 IF THESE ARE SET THE CALL IF FROM THE REPRINT OPTION
  1.  S:'$G(BARDUZ2) BARDUZ2=DUZ(2)
  1.  W !!,"Select device to print Finance letter..."
  1.  S %ZIS("B")=""
  1.  S %ZIS="MQO"
  1.  D ^%ZIS
  1.  Q:POP
  1.  ;I IO=IO(0) W !!,"CAN'T PRINT LETTER TO THE SCREEN!!" H 2 G LETTER1  ;BAR*1.8*4 SCR56
  1.  I $D(IO("Q")) D QUE Q
  1.  U IO
  1.  D PRINT
  1.  W @IOF
  1.  D ^%ZISC
  1.  Q
  1. QUE ; EP - QUE 'NOT SENT' OR 'DELAY SEND' REPORT
  1.  S ZTRTN="PRINT^BARUFLTR"
  1.  S ZTDESC=BARLTR
  1.  S ZTSAVE("BAR*")=""
  1.  D ^%ZTLOAD
  1.  I $D(ZTSK)[0 W !!?5,"Report Cancelled!"
  1.  E  W !!?5,"Report task #: ",$G(ZTSK)
  1.  D HOME^%ZIS
  1.  Q
  1.  ;
  1. PRINT ;EP - PRINT THE LETTER
  1.  N LTRIEN,LINE
  1.  K DIC,DIR,DR,DA,DIE
  1.  S X=BARLTR
  1.  S DIC="^BAR(90052.03,"
  1.  S DIC(0)="QELM"
  1.  D ^DIC
  1.  I Y<0 W !,"CANNOT FIND '"_BARLTR_" IN A/R LETTERS & TEXT FILE" Q
  1.  ;TRAVERSE THE LETTER
  1.  S LTRIEN=+Y
  1.  S LINE=0
  1.  F  S LINE=$O(^BAR(90052.03,LTRIEN,1,LINE)) Q:'LINE  D
  1.  .S LINETXT=^BAR(90052.03,LTRIEN,1,LINE,0)
  1.  .Q:$E(LINETXT)=";"  ;COMMENT LINE
  1.  .I $E(LINETXT)="~" X $P(LINETXT,"~",2)
  1.  .E  W !,LINETXT
  1.  I $F("789",LTRIEN)&$G(BARPRTQ)=1 D PUCCMT  ; BAR1.8*17 PKD 2/24/2010
  1.  Q:'BARSAVE  ;BAR*1.8*4 DO NOT SAVE IF THIS IS A REPRINT
  1.  D SAVE(BARAMT,BARCOL,BARCHK,BARSCHED,BARINS,LTRIEN,$G(BARRETYP),$G(BARADJT))  ;BAR*1.8*4 SAVE DATA INTO A/R PRINTED LETTERS FILE
  1.  Q
  1.  ;
  1.  ; BEGIN NEW CODE BAR*1.8.*17
  1. PUCCMT ;
  1.  ; IF COMMENTS FOR PUC ITEMS, RETRIEVE & PRINT	BAR*1.8*17 pkd 2/24/2010
  1.  N CMT,DSH,LN
  1.  S CMT=0 Q:$G(^BARCOL(DUZ(2),BARTX(14,"I"),1,BARTX(15,"I"),7,0))=""
  1.  M CMT=^BARCOL(DUZ(2),BARTX(14,"I"),1,BARTX(15,"I"),7)
  1.  S CMT=$P(CMT(0),"^",3) Q:'CMT
  1.  S $P(DSH,"=",79)=""
  1.  W !!,DSH,!,"Comments:" F LN=1:1:CMT W !,CMT(LN,0)
  1.  Q
  1.  ;
  1.  ;BAR*1.8*4
  1. SAVE(BARAMT,BARCOL,BARCHK,BARSCHED,BARINS,LTRIEN,BARRETYP,BARADJT) ;
  1.  D NOW^%DTC
  1.  S (DINUM,X)=%
  1.  S DIC(0)=""
  1.  S DIC="^BAR(90052,"
  1.  S DIC("DR")=".02////^S X=BARDUZ;"
  1.  S DIC("DR")=DIC("DR")_".03////^S X=BARDUZ2;"
  1.  S DIC("DR")=DIC("DR")_".04////^S X=BARAMT;"
  1.  S DIC("DR")=DIC("DR")_".05////^S X=BARCOL;"
  1.  S DIC("DR")=DIC("DR")_".06////^S X=BARCHK;"
  1.  S DIC("DR")=DIC("DR")_".07////^S X=BARSCHED;"
  1.  S DIC("DR")=DIC("DR")_".08////^S X=BARINS;"
  1.  S DIC("DR")=DIC("DR")_".09////^S X=LTRIEN;"
  1.  I BARLTR["UNBILLED" S DIC("DR")=DIC("DR")_".11////^S X=BARRETYP"
  1.  E  S DIC("DR")=DIC("DR")_".12////^S X=BARRETYP"
  1.  K DO D FILE^DICN
  1.  Q
  1.  ;
  1. REPRINT ;EP - REPRINT ALREADY PRINTED LETTERS
  1.  N BARAMT,BARCOL,BARCHK,BARSCHED,BARINS,BARLTR,BARRETYP,BAREXTYP
  1.  K NOSAVE
  1.  K DIC,DIR,DIE,DA,DR
  1.  S DIC(0)="AEMQ"
  1.  S DIC="^BAR(90052,"
  1.  S DIC("W")="D ID^BARUFLTR"
  1.  W !!
  1.  D ^DIC
  1.  Q:Y<0
  1.  S IENS=+Y_","
  1.  S BARDUZ=$$GET1^DIQ(90052,IENS,.02,"I")
  1.  S BARDUZ2=$$GET1^DIQ(90052,IENS,.03,"I")
  1.  S BARAMT=$$GET1^DIQ(90052,IENS,.04,"I")
  1.  S BARCOL=$$GET1^DIQ(90052,IENS,.05,"I")
  1.  S BARCHK=$$GET1^DIQ(90052,IENS,.06,"I")
  1.  S BARSCHED=$$GET1^DIQ(90052,IENS,.07,"I")
  1.  S BARINS=$$GET1^DIQ(90052,IENS,.08,"I")
  1.  S BARLTR=$$GET1^DIQ(90052,IENS,.09,"E")
  1.  S BARRETYP=$$GET1^DIQ(90052,IENS,.11,"I")
  1.  S BARRETYP=BARRETYP_" "_$$GET1^DIQ(90052,IENS,.11,"E")
  1.  S BARSAVE=0
  1.  D LETTER1
  1.  Q
  1.  ;
  1. ID ;EP- DISPLAY LIST FOR 'A/R PRINTED LETTERS'
  1.  ;+Y IS INTERNAL IEN
  1.  N TYPE
  1.  S TYPE=$$GET1^DIQ(90052,+Y_",",.09,"E")
  1.  W ?22,$P(TYPE," LETTER")  ;TYPE OF LETTER
  1.  W ?45,$J($$GET1^DIQ(90052,+Y_",",.04,"E"),10,2)  ;AMOUNT
  1.  W !?27,$S(TYPE["UNBILLED":$$GET1^DIQ(90052,+Y_",",.11,"I"),1:$$GET1^DIQ(90052,+Y_",",.12,"I"))  ;TYPE OF REIMBURSEMENT OR ADJUSTMENT TYPE
  1.  W !?6,$$GET1^DIQ(90052,+Y_",",.05,"I")
  1.  W ?60,$$GET1^DIQ(90052,+Y_",",.02,"E")  ;USER
  1.  Q