80 lines
4.1 KiB
Mathematica
80 lines
4.1 KiB
Mathematica
PRPFPUR1 ;CTB/ALTOONA PURGE ONE PATIENT FUNDS RECORD ;7/15/97 9:55 AM
|
|
V ;;3.0;PATIENT FUNDS;**6,7**;JUNE 1, 1989
|
|
ONE(X) ;
|
|
;PURGE PATIENT FUNDS MASTER TRANSACTION FILE AND PATIENT TRANSACTION
|
|
; MULTIPLE FOR ONE PATIENT THRU AND INCLUDING EDATE.
|
|
;DFN=INTERNAL REFERENCE FOR PATIENT
|
|
;EDATE=INTERNAL FM DATE, ALL TRANSACTIONS THRU AND INCLUDING THIS
|
|
; DATE WILL BE SUMMARIZED AND DELETED.
|
|
;K ^TMP(UCIJOB,"PRPFPURGE",DFN)
|
|
N DATE,ERROR,PBAL,GBAL,TRDA,TRNODE,MADA,MANODE,BAL,REC,MREC,MRECID,UCIJOB,DFN,EDATE
|
|
S DFN=$P(X,",",1),EDATE=$P(X,",",2)
|
|
X ^%ZOSF("UCI") S UCIJOB=Y_","_$J
|
|
S (DATE,ERROR,PBAL,GBAL,BAL)=0
|
|
F S DATE=$O(^PRPF(470,DFN,3,"AC",DATE)) Q:DATE=""!(DATE>EDATE)!(ERROR) D
|
|
. S (TRDA,ERROR)=0
|
|
. F S TRDA=$O(^PRPF(470,DFN,3,"AC",DATE,TRDA)) Q:TRDA="" D Q:ERROR
|
|
. . S ERROR=$$VERIFY(DFN,TRDA,DATE) Q:ERROR
|
|
. . S ^TMP(UCIJOB,"PRPFPURGE",DFN,TRDA)=""
|
|
. . QUIT
|
|
. QUIT
|
|
I ERROR S X="ERROR FOUND IN PROCESSING PURGE FOR "_$P(^DPT(DFN,0),"^",1)_". <No Purge has occurred for this patient>" D MSG^PRPFU1 Q
|
|
S TRDA=0,REC=0
|
|
F S TRDA=$O(^TMP(UCIJOB,"PRPFPURGE",DFN,TRDA)) Q:'TRDA D
|
|
. N TRNODE,TPAMT,TGAMT,TAMT,MADA,MID
|
|
. S TRNODE=^PRPF(470,DFN,3,TRDA,0)
|
|
. S TPAMT=$P(TRNODE,"^",4),TGAMT=$P(TRNODE,"^",5),TAMT=$P(TRNODE,"^",3),MADA=$P(TRNODE,"^",1),MID=$P(^PRPF(470.1,MADA,0),"^")
|
|
. S PBAL=PBAL+TPAMT,GBAL=GBAL+TGAMT,BAL=BAL+TAMT
|
|
. S REC=TRDA,MREC=MADA,MRECID=MID
|
|
. D ;DELETE MASTER TRANSACTION
|
|
. . N NODE
|
|
. . S NODE=$G(^PRPF(470.1,MADA,0)) Q:NODE=""
|
|
. . I $P(NODE,"^",1)]"" K ^PRPF(470.1,"B",$P(NODE,"^",1),MADA)
|
|
. . I $P(NODE,"^",5)]"" K ^PRPF(470.1,"AD",$P(NODE,"^",4),MADA)
|
|
. . I $P(NODE,"^",6)]"" K ^PRPF(470.1,"AC",$P(NODE,"^",6),MADA)
|
|
. . L +^PRPF(470.1,0):10 I $T S $P(^(0),"^",4)=$P(^PRPF(470.1,0),"^",4)-1 L -^PRPF(470.1,0)
|
|
. . K ^PRPF(470.1,MADA)
|
|
. . QUIT ;DELETE MASTER TRANSACTION
|
|
. D ;DELETE PATIENT TRANSACTION
|
|
. . N NODE
|
|
. . S NODE=$G(^PRPF(470,DFN,3,TRDA,0)) Q:NODE=""
|
|
. . I $P(NODE,"^",1)]"" K ^PRPF(470,DFN,3,"B",$P(NODE,"^",1),TRDA)
|
|
. . I $P(NODE,"^",2)]"" K ^PRPF(470,DFN,3,"AC",$P(NODE,"^",2),TRDA)
|
|
. . L +^PRPF(470,DFN,3,0):10 I $T S $P(^(0),"^",4)=$P(^PRPF(470,DFN,3,0),"^",4)-1 L -^PRPF(470,DFN,3,0)
|
|
. . K ^PRPF(470,DFN,3,TRDA)
|
|
. . QUIT ;DELETE PATIENT TRANSACTION
|
|
. QUIT
|
|
;ENTER BALANCE CARRIED FORWARD TRANSACTION
|
|
Q:REC=0
|
|
L +^PRPF
|
|
S $P(^PRPF(470.1,0),"^",4)=$P(^PRPF(470.1,0),"^",4)+1
|
|
S $P(^PRPF(470,DFN,3,0),"^",4)=$P(^PRPF(470,DFN,3,0),"^",4)+1
|
|
S ^PRPF(470,DFN,3,REC,0)=MREC_"^"_EDATE_"^"_BAL_"^"_PBAL_"^"_GBAL_"^",^PRPF(470,DFN,3,"B",MREC,REC)="",^PRPF(470,DFN,3,"AC",EDATE,REC)=""
|
|
S X=$O(^PRPF(470.2,"B","BALCARFWD",0))
|
|
S MREC(0)=MRECID_"^"_DFN_"^"_REC_"^"_BAL_"^"_EDATE_"^"_EDATE_"^BALCARFWD^D^3^B^"_X_"^"_PBAL_"^"_GBAL_"^"_DUZ_"^^Balance Carried Forward - Purge"
|
|
S MREC(1)=$P(^VA(200,DUZ,0),"^")
|
|
S STRING=$$SUM^PRPFSIG(MREC_"^"_$P(MREC(0),"^",4,6))
|
|
S $P(MREC(0),"^",15)=$$ENCODE^PRPFSIG(MREC(1),DUZ,STRING)
|
|
S ^PRPF(470.1,MREC,0)=MREC(0),^(1)=MREC(1)
|
|
S ^PRPF(470.1,"B",MRECID,MREC)="",^PRPF(470.1,"AD",EDATE,MREC)="",^PRPF(470.1,"AC",EDATE,MREC)=""
|
|
L -^PRPF
|
|
K ^TMP(UCIJOB,"PRPFPURGE")
|
|
QUIT
|
|
;
|
|
VERIFY(DFN,TRDA,DATE) ;VERIFY INTEGRITY OF INDIVIDUAL PATIENT TRANSACTION
|
|
; AND ASSOCIATED MASTER TRANSACTION.
|
|
N TRNODE,ERROR,TDATE,MDATE,MAMT,MPAMT,MGAMT,TGAMT,TAMT,TPAMT,TBAL,MADA,MNODE
|
|
S TRNODE=$G(^PRPF(470,DFN,3,TRDA,0)) I TRNODE="" S ERROR=1 D ERROR Q
|
|
S TDATE=$P(TRNODE,"^",2),TAMT=$P(TRNODE,"^",3),TPAMT=$P(TRNODE,"^",4),TGAMT=$P(TRNODE,"^",5),TBAL=$P(TRNODE,"^",6),MADA=+TRNODE
|
|
S MNODE=$G(^PRPF(470.1,+MADA,0)) I MNODE="" S ERROR=3 D ERROR Q 1
|
|
S MDATE=$P(MNODE,"^",5),MAMT=$P(MNODE,"^",4),MPAMT=$P(MNODE,"^",12),MGAMT=$P(MNODE,"^",13)
|
|
I TDATE=""!(TDATE'=$P(DATE,".")) S ERROR=1 D ERROR Q 1
|
|
I (+TAMT'=+MAMT)!(+TPAMT'=+MPAMT)!(+TGAMT'=+MGAMT) S ERROR=4 D ERROR Q 1
|
|
I MDATE'=TDATE S ERROR=2 D ERROR Q 1
|
|
Q 0
|
|
ERROR S X=$P($T(ERROR+ERROR),";",3,99)_" "_TRDA D MSG^PRPFU1 W ! Q
|
|
;;INVALID 'AC' CROSS REFERENCE IN FILE 470, FIELD 30
|
|
;;DATE IN TRANSACTION MULTIPLE OF 470 DOES NOT MATCH CROSS REFERENCE
|
|
;;PATIENT TRANSACTION MULTIPLE POINTS TO INVALID MASTER RECORD
|
|
;;BALANCES ARE OUT OF DATE BETWEEN MASTER TRANSACTION FILE AND PATIENT TRANSACTION MULTIPLE
|