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

ABSPOSP.m

Go to the documentation of this file. 
  1. ABSPOSP ; IHS/FCS/DRS - Pharm POS pay/adj batches ;    [ 09/12/2002  10:17 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**3,48**;JUN 21, 2001;Build 38
  1.  ; main entry points and some callable utilities are in here
  1.  Q
  1. TEST ;
  1.  W "Test NEWBATCH: "
  1.  S BATCH=$$NEWBATCH
  1.  W BATCH,! Q:'BATCH
  1.  W "Test GETPMT: ",$$GETPMT(BATCH),!
  1.  W "Test ADDPMT: ",$$ADDPMT(BATCH,100),!
  1.  W "Test ADDPMT: ",$$ADDPMT(BATCH,25.41),! ; should be 125.41
  1.  W "Test GETPMT: ",$$GETPMT(BATCH),!
  1.  Q
  1. NEWBATCH(ECHO) ;EP - create a new batch
  1.  I '$G(ECHO) S ECHO=1
  1.  N FDA,IEN,MSG,FN S FN=9001625.1 ; PAYMENT BATCH file
  1.  N X S X="+1,"
  1.  S FDA(FN,X,.01)=$P(^ABSBPMNT(0),U,3)+1 ; HEADER CONTROL NUMBER
  1.  S FDA(FN,X,.02)=DT ; DATE CREATED
  1.  S FDA(FN,X,.03)=DUZ ; CREATED BY
  1.  S FDA(FN,X,.04)=0 ; PAYMENT CONTROL TOTAL
  1.  S FDA(FN,X,.05)="A" ; active
  1.  S FDA(FN,X,.045)=0 ; CONTRACTUAL ALLOWANCE CONTROL
  1.  S FDA(FN,X,.08)=DT ; DEPOSIT DATE
  1.  D UPDATE^DIE("S","FDA","IEN","MSG")
  1.  I $D(MSG) D LOG^ABSPOSL2("NEWBATCH^ABSPOSP",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  I $D(MSG),$G(ECHO) D
  1.  . W "Failed to create the batch!",!
  1.  . D ZWRITE^ABSPOS("MSG")
  1.  . W !
  1.  . D PRESSANY
  1.  Q $G(IEN(1))
  1. PAYMENT(PCNDFN,BATCH,AMOUNT,INSDFN,DEPDATE,RECEIPT,CHECKNUM) ;EP - store a pmt
  1.  D ADDPMT(BATCH,AMOUNT)
  1.  I '$D(RECEIPT) S RECEIPT="EOB"
  1.  I '$D(CHECKNUM) S CHECKNUM=""
  1.  N N S N=$O(^ABSTMP(BATCH,"PMT",PCNDFN,""),-1)+1
  1.  N X S X=AMOUNT_U_INSDFN_U_$P(^AUTNINS(INSDFN,0),U)_U_DEPDATE
  1.  S X=X_U_BATCH_U_RECEIPT_U_CHECKNUM
  1.  S ^ABSTMP(BATCH,"PMT",PCNDFN,N)=X
  1.  S ^ABSTMP(BATCH,"TOT",PCNDFN)=$G(^ABSTMP(BATCH,"TOT",PCNDFN))+AMOUNT
  1.  S ^ABSTMP(BATCH,"PTOT")=$G(^ABSTMP(BATCH,"PTOT"))+AMOUNT
  1.  Q
  1. ADJUST(PCNDFN,BATCH,AMOUNT,REASON) ;EP - store an adjustment
  1.  D ADDADJ(BATCH,AMOUNT) ; add to batch totals
  1.  N N S N=$O(^ABSTMP(BATCH,"ADJ",PCNDFN,""),-1)+1
  1.  N X S X=AMOUNT_U_REASON_U_$$GETAMT(BATCH,.08)_U_BATCH
  1.  S ^ABSTMP(BATCH,"ADJ",PCNDFN,N)=X
  1.  S ^ABSTMP(BATCH,"TOT",PCNDFN)=$G(^ABSTMP(BATCH,"TOT",PCNDFN))+AMOUNT
  1.  Q
  1. GETPMT(BATCH)      Q $$GETAMT(BATCH,.04) ; get PAYMENT CONTROL TOTAL
  1. ADDPMT(BATCH,AMT)      ;
  1.  S X=$$ADDAMT(BATCH,AMT,.04)
  1.  Q:$Q X Q
  1. GETADJ(BATCH)      Q $$GETAMT(BATCH,.045) ; get CONTRACTUAL ALLOWANCE CONTROL
  1. ADDADJ(BATCH,AMT)     ; 
  1.  N X S X=$$ADDAMT(BATCH,AMT,.045)
  1.  Q:$Q X Q
  1. GETAMT(BATCH,FIELD)          ; actually, it works for any field in this file
  1.  N FDA,IEN,MSG,FN S FN=9001625.1
  1.  S X=$$GET1^DIQ(FN,BATCH,FIELD,,,"MSG")
  1.  I $D(MSG) D ZWRITE^ABSPOS("BATCH","FIELD","MSG"),IMPOSS^ABSPOSUE("FM","TI","$$GET1^DIQ failed",,"GETAMT",$T(+0))
  1.  Q X
  1. ADDAMT(BATCH,AMT,FIELD)        ; add to the adjustment total ; either $$ or not
  1.  N X S X=$$GETAMT(BATCH,FIELD)
  1.  S X=$$SETAMT(BATCH,X+AMT,FIELD)
  1.  Q:$Q X Q
  1. SETAMT(BATCH,AMT,FIELD) ;EP - store the adjustment total ; either $$ or not
  1.  N FDA,IEN,MSG,FN S FN=9001625.1    ;; /IHS/OIT/RAM ; ANOTHER FM FILE THAT DOESN'T EXIST IN (AT LEAST) THE TRAINING DATABASES...
  1.  S FDA(FN,BATCH_",",FIELD)=AMT
  1.  D SETAMT1
  1.  Q:$Q AMT Q
  1. SETAMT1 ;
  1.  D FILE^DIE("K","FDA","MSG")
  1.  I $D(MSG) D LOG^ABSPOSL2("SETAMT1^ABSPOSP",.MSG) ; /IHS/OIT/RAM ; 12 JUN 17 ; AND LOG IT IF AN ERROR OCCURS.
  1.  Q:'$D(MSG)  ; success
  1.  D ZWRITE^ABSPOS("FN","BATCH","FIELD","MSG")
  1.  I $$IMPOSS^ABSPOSUE("FM","TRI","FILE^DIE failed",,"SETAMT1",$T(+0))
  1.  Q
  1. PRESSANY D PRESSANY^ABSPOSU5(0,300) Q