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

BARFPST2.m

Go to the documentation of this file. 
  1. BARFPST2 ; IHS/SD/LSL - A/R FLAT RATE POSTING (CONT) ;
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
  1.  ;;
  1. DOC ;
  1.  ; LSL - 12/31/1999 - Created routine
  1.  ;       Contains code for saving data to A/R FLAT RATE POSTING File
  1.  ;;
  1.  Q
  1.  ; *********************************************************************
  1. BARSAV ; EP
  1.  ; EP - Save data in A/R FLAT RATE POSTING File 
  1.  S BARFRPC=$$VAL^XBDIQ1(200,DUZ,1)  ; Initials of user
  1.  D NOW^%DTC                         ; Current date/time
  1.  S BARDT=%                          ; FM entry date
  1.  ; FRP postable amount
  1.  S BARPAMT=$$VAL^XBDIQ1(90051.1101,"BARCOL,BARITM",19)
  1.  D:'$D(BARIEN) NEWENTRY             ; Create new entry
  1.  Q:$D(BARNONE)                      ; Q if entry to FRP file fails
  1.  D CORDAT                           ; Save data not placed in a mult
  1.  D:$D(BARADJ) ADJDAT                ; Save adjustment data
  1.  D FACDAT                           ; Save facility data
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. NEWENTRY ;
  1.  ; Create new entry in A/R FLAT RATE POSTING File
  1.  ; Build BARNAME
  1.  S Y=BARDT X ^DD("DD")              ; Entry date in external format
  1.  S BARNAME=BARFRPC_"-"_Y            ; FRP batch name (init-date)
  1.  ; Create new entry
  1.  K DIC
  1.  S DIC="^BARFRP(DUZ(2),"
  1.  S DIC(0)="L"
  1.  S DIC("P")=$P(^DIC(90054.01,0),U,2)
  1.  S X=BARNAME
  1.  K DD,DO
  1.  D FILE^DICN                        ; Add entry to FRP
  1.  K DIC
  1.  I +Y<1 D  Q
  1.  . W *7
  1.  . W !!,"Entry in A/R FLAT RATE POSTING File was not created."
  1.  . W !,"Contact your supervisor."
  1.  . S BARNONE=1                      ; Flag - entry failed
  1.  S BARIEN=+Y                        ; IEN to A/R FLAT RATE POSTING File
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. CORDAT ;
  1.  ; Enter data in A/R FLAT RATE POSTING File that doesn't go in a mult
  1.  K DA,DR,DIE
  1.  S DIE="^BARFRP(DUZ(2),"
  1.  S DA=BARIEN                        ; IEN to A/R FLAT RATE POSTING File
  1.  S DR=".02////"_BARDT               ; Date Entered
  1.  S DR=DR_";.04////"_BARCOL          ; Batch Name
  1.  S DR=DR_";.05////"_BARITM          ; Batch Item Number
  1.  S DR=DR_";.06////"_DUZ             ; FRP Entry Clerk
  1.  S DR=DR_";.08////"_DUZ(2)          ; Parent Facility
  1.  S:$D(BARPAY) DR=DR_";.09///"_BARPAY  ; Payment Amount
  1.  S DR=DR_";.1///"_BARPAMT           ; Item postable amount
  1.  D ^DIE
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. ADJDAT ;
  1.  ; Enter data in Adjustments multiple of A/R FLATE RATE POSTING File
  1.  ; Kill current Adjustments multiple in A/R FLAT RATE POSTING File
  1.  S DA(1)=BARIEN                     ; IEN to A/R FLAT RATE POSTING File
  1.  S DIK="^BARFRP(DUZ(2),"_DA(1)_",1,"
  1.  S I=0
  1.  F  S I=$O(^BARFRP(DUZ(2),DA(1),1,I)) Q:'+I  D  ; Loop adjustments
  1.  . S DA=I
  1.  . D ^DIK                           ; Kill Adjustment entry
  1.  S I=0
  1.  F  S I=$O(BARADJ(I)) Q:'+I  D      ; Loop Adjustment array
  1.  . S BARSCAT=$P(BARADJ(I),U,2)      ; IEN to A/R TABLE TYPE /IHS (Cat)
  1.  . S BARSTYP=$P(BARADJ(I),U,4)      ; IEN to A/R TABLE ENTRY /IHS (Type)
  1.  . S BARSAMT=$P(BARADJ(I),U)        ; Adjustment Amount
  1.  . K DIC
  1.  . S DIC="^BARFRP(DUZ(2),"_BARIEN_",1,"
  1.  . S DIC("P")=$P(^DD(90054.01,10,0),U,2)
  1.  . S DIC(0)="L"
  1.  . S DIC("DR")=".02////"_BARSTYP_";.03////"_BARSAMT
  1.  . S X=BARSCAT
  1.  . K DD,DO
  1.  . D FILE^DICN                      ; Create Adjustment entry
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. FACDAT ;
  1.  ; Enter facility data
  1.  S BARENTF=$D(^BARFRP(DUZ(2),BARIEN,2,"B",BAREOB))
  1.  ; If this Fac not in A/R FLAT RATE POSTING File, create new entry
  1.  I BARENTF=0!(BARENTF=1) D
  1.  . K DIC
  1.  . S DA(1)=BARIEN                   ; IEN to A/R FLAT RATE POSTING File
  1.  . S DIC="^BARFRP(DUZ(2),"_BARIEN_",2,"
  1.  . S DIC("P")=$P(^DD(90054.01,20,0),U,2)
  1.  . S DIC(0)="L"
  1.  . S X=BAREOB                       ; IEN to VISIT LOC mult of A/R COLL
  1.  . K DD,DO
  1.  . D FILE^DICN                      ; Create VISIT LOC entry in FRP
  1.  . S BARFIEN=+Y                     ; IEN to VISIT LOC mult of FRP
  1.  E  S BARFIEN=$O(^BARFRP(DUZ(2),BARIEN,2,"B",BAREOB,""))
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. TOT(X) ; EP
  1.  ; EP - Computed field ITEM BALANCE
  1.  ; X = FRP Batch IEN
  1.  S (I,BARCNT)=0
  1.  F  S I=$O(^BARFRP(DUZ(2),X,2,I)) Q:'+I  D
  1.  . S J=0
  1.  . F  S J=$O(^BARFRP(DUZ(2),X,2,I,3,J)) Q:'+J  D
  1.  . . S BARCNT=BARCNT+1                       ; Number of bills
  1.  S BARPAMNT=$P($G(^BARFRP(DUZ(2),X,0)),U,9)  ; Payment amount
  1.  S BARTOT=BARPAMNT*BARCNT                    ; Total Payments 
  1.  Q BARTOT
  1.  ; *********************************************************************
  1.  ;
  1. FACTOT(X,Y)        ; EP
  1.  ; EP - computed field TOTAL POSTED AMOUNT  (by visit location)
  1.  ; X = FRP batch IEN
  1.  ; Y = FAC IEN
  1.  S BARCNT=0
  1.  N I
  1.  S I=0
  1.  F  S I=$O(^BARFRP(DUZ(2),X,2,Y,3,I)) Q:'+I  D
  1.  . S BARCNT=BARCNT+1                         ; Number of bills this FAC
  1.  S BARPAMNT=$P($G(^BARFRP(DUZ(2),X,0)),U,9)  ; Payment amount
  1.  S BARFTOT=BARPAMNT*BARCNT                   ; Total payments
  1.  Q BARFTOT