RCDPXPA1 ;WISC/RFJ-server, utilities for transmission file 344.2 ;1 Jun 99
;;4.5;Accounts Receivable;**114,150**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
ADDTRAN(DATE) ; if the transmission date is not entered, add it
; already in file
I $D(^RCY(344.2,+DATE,0)) Q 1
;
; add it
N %DT,D0,DA,DD,DI,DIC,DIE,DINUM,DLAYGO,DO,DQ,DR,X,Y
S DIC="^RCY(344.2,",DIC(0)="L",DLAYGO=344.2
; .02 = total sequences (set to 0) .03 = total dollars (set to 0)
; .04 = status (set to receiving) .06 = checksum (set to 0)
S DIC("DR")=".02////0;.03////0;.04////r;.05///TODAY;.06////0"
S (X,DINUM)=DATE
D FILE^DICN
I Y>0 Q 1
Q 0
;
;
TRANDOLL(DA,SEQUENCE,DOLLARS) ; store the total sequences and total dollars
I '$D(^RCY(344.2,+DA,0)) Q
N D,D0,DI,DIC,DIE,DQ,DR,X
S (DIC,DIE)="^RCY(344.2,"
S DR=""
; only store total sequence and dollars if not zero, otherwise it
; may reset the values to zero
I SEQUENCE S DR=".02////"_SEQUENCE_";"
I DOLLARS S DR=DR_".03////"_DOLLARS_";"
I DR="" Q
D ^DIE
Q
;
;
TRANCSUM(TRANSDA,SEQUENCE,CHECKSUM) ; store the transmissions checksum
N D,D0,DA,DI,DIC,DIE,DQ,DR,X
S (DIC,DIE)="^RCY(344.2,"_TRANSDA_",1,"
S DA(1)=TRANSDA,DA=SEQUENCE
S DR=".05///"_CHECKSUM_";"
D ^DIE
Q
;
;
TRANSTAT(DA,STATUS) ; store the transmissions status
I '$D(^RCY(344.2,+DA,0)) Q
N %,%DT,D,D0,DDER,DI,DIC,DIE,DQ,DR,X
S (DIC,DIE)="^RCY(344.2,"
S DR=".04///"_STATUS_";.05///TODAY;"
D ^DIE
Q
;
;
TRANERR(DA,RCDPXMZ,ERROR) ; store the error message
I '$D(^RCY(344.2,+DA,0)) Q
N DA1
S DA1=$P($G(^RCY(344.2,DA,2,0)),"^",3)+1
S ^RCY(344.2,DA,2,DA1,0)="Message: "_RCDPXMZ_", Error: "_ERROR
S ^RCY(344.2,DA,2,0)="^^"_DA1_"^"_DA1_"^"_DT_"^"
Q
;
;
ADDSEQ(TRANSDA,SEQUENCE) ; add sequence for transmission (in transda)
I 'SEQUENCE Q 0
I '$D(^RCY(344.2,+TRANSDA,0)) Q 0
I $D(^RCY(344.2,TRANSDA,1,SEQUENCE,0)) Q SEQUENCE
I '$D(^RCY(344.2,TRANSDA,1,0)) S ^(0)="^344.21^"
N D0,DA,DI,DIC,DIE,DINUM,DLAYGO,DO,DQ,DR,X,Y
;
S (DINUM,X)=+SEQUENCE
S DA(1)=TRANSDA
S DIC="^RCY(344.2,"_TRANSDA_",1,",DIC(0)="L",DLAYGO=344.21
S DIC("DR")=".12////"_DUZ_";.06///TODAY;"
D FILE^DICN
Q +Y
;
;
SEQUDOLL(TRANSDA,SEQUENCE,COUNT,DOLLARS,MAILMESS) ; store the total
; transactions (in count), dollars (in dollars), and mail message
; number for the transmission sequence
N D,D0,DA,DI,DIC,DIE,DQ,DR,X
S (DIC,DIE)="^RCY(344.2,"_TRANSDA_",1,"
S DA(1)=TRANSDA,DA=SEQUENCE
S DR=".02///"_COUNT_";.03///"_DOLLARS_";"
I MAILMESS S DR=DR_".04////"_MAILMESS_";"
D ^DIE
Q
;
;
DELETRAN(DA) ; delete the transmission from the file
I '$D(^RCY(344.2,+DA,0)) Q
N %,DIC,DIK
S DIK="^RCY(344.2,"
D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPXPA1 2775 printed Dec 13, 2024@01:46:41 Page 2
RCDPXPA1 ;WISC/RFJ-server, utilities for transmission file 344.2 ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,150**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
ADDTRAN(DATE) ; if the transmission date is not entered, add it
+1 ; already in file
+2 IF $DATA(^RCY(344.2,+DATE,0))
QUIT 1
+3 ;
+4 ; add it
+5 NEW %DT,D0,DA,DD,DI,DIC,DIE,DINUM,DLAYGO,DO,DQ,DR,X,Y
+6 SET DIC="^RCY(344.2,"
SET DIC(0)="L"
SET DLAYGO=344.2
+7 ; .02 = total sequences (set to 0) .03 = total dollars (set to 0)
+8 ; .04 = status (set to receiving) .06 = checksum (set to 0)
+9 SET DIC("DR")=".02////0;.03////0;.04////r;.05///TODAY;.06////0"
+10 SET (X,DINUM)=DATE
+11 DO FILE^DICN
+12 IF Y>0
QUIT 1
+13 QUIT 0
+14 ;
+15 ;
TRANDOLL(DA,SEQUENCE,DOLLARS) ; store the total sequences and total dollars
+1 IF '$DATA(^RCY(344.2,+DA,0))
QUIT
+2 NEW D,D0,DI,DIC,DIE,DQ,DR,X
+3 SET (DIC,DIE)="^RCY(344.2,"
+4 SET DR=""
+5 ; only store total sequence and dollars if not zero, otherwise it
+6 ; may reset the values to zero
+7 IF SEQUENCE
SET DR=".02////"_SEQUENCE_";"
+8 IF DOLLARS
SET DR=DR_".03////"_DOLLARS_";"
+9 IF DR=""
QUIT
+10 DO ^DIE
+11 QUIT
+12 ;
+13 ;
TRANCSUM(TRANSDA,SEQUENCE,CHECKSUM) ; store the transmissions checksum
+1 NEW D,D0,DA,DI,DIC,DIE,DQ,DR,X
+2 SET (DIC,DIE)="^RCY(344.2,"_TRANSDA_",1,"
+3 SET DA(1)=TRANSDA
SET DA=SEQUENCE
+4 SET DR=".05///"_CHECKSUM_";"
+5 DO ^DIE
+6 QUIT
+7 ;
+8 ;
TRANSTAT(DA,STATUS) ; store the transmissions status
+1 IF '$DATA(^RCY(344.2,+DA,0))
QUIT
+2 NEW %,%DT,D,D0,DDER,DI,DIC,DIE,DQ,DR,X
+3 SET (DIC,DIE)="^RCY(344.2,"
+4 SET DR=".04///"_STATUS_";.05///TODAY;"
+5 DO ^DIE
+6 QUIT
+7 ;
+8 ;
TRANERR(DA,RCDPXMZ,ERROR) ; store the error message
+1 IF '$DATA(^RCY(344.2,+DA,0))
QUIT
+2 NEW DA1
+3 SET DA1=$PIECE($GET(^RCY(344.2,DA,2,0)),"^",3)+1
+4 SET ^RCY(344.2,DA,2,DA1,0)="Message: "_RCDPXMZ_", Error: "_ERROR
+5 SET ^RCY(344.2,DA,2,0)="^^"_DA1_"^"_DA1_"^"_DT_"^"
+6 QUIT
+7 ;
+8 ;
ADDSEQ(TRANSDA,SEQUENCE) ; add sequence for transmission (in transda)
+1 IF 'SEQUENCE
QUIT 0
+2 IF '$DATA(^RCY(344.2,+TRANSDA,0))
QUIT 0
+3 IF $DATA(^RCY(344.2,TRANSDA,1,SEQUENCE,0))
QUIT SEQUENCE
+4 IF '$DATA(^RCY(344.2,TRANSDA,1,0))
SET ^(0)="^344.21^"
+5 NEW D0,DA,DI,DIC,DIE,DINUM,DLAYGO,DO,DQ,DR,X,Y
+6 ;
+7 SET (DINUM,X)=+SEQUENCE
+8 SET DA(1)=TRANSDA
+9 SET DIC="^RCY(344.2,"_TRANSDA_",1,"
SET DIC(0)="L"
SET DLAYGO=344.21
+10 SET DIC("DR")=".12////"_DUZ_";.06///TODAY;"
+11 DO FILE^DICN
+12 QUIT +Y
+13 ;
+14 ;
SEQUDOLL(TRANSDA,SEQUENCE,COUNT,DOLLARS,MAILMESS) ; store the total
+1 ; transactions (in count), dollars (in dollars), and mail message
+2 ; number for the transmission sequence
+3 NEW D,D0,DA,DI,DIC,DIE,DQ,DR,X
+4 SET (DIC,DIE)="^RCY(344.2,"_TRANSDA_",1,"
+5 SET DA(1)=TRANSDA
SET DA=SEQUENCE
+6 SET DR=".02///"_COUNT_";.03///"_DOLLARS_";"
+7 IF MAILMESS
SET DR=DR_".04////"_MAILMESS_";"
+8 DO ^DIE
+9 QUIT
+10 ;
+11 ;
DELETRAN(DA) ; delete the transmission from the file
+1 IF '$DATA(^RCY(344.2,+DA,0))
QUIT
+2 NEW %,DIC,DIK
+3 SET DIK="^RCY(344.2,"
+4 DO ^DIK
+5 QUIT
