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