PRCAFBD1 ;WASH-ISC@ALTOONA,PA/CLH-FMS Billing Document Utilities ;8/2/95 3:19 PM
V ;;4.5;Accounts Receivable;**16**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
DTYPE(BD) ;Return related documents for a BD
;Input BD type
;output =bd type^reserved^CR^WR
;ie: input= 24
; output=24^1^05^01
N X
I 'BD Q -1
I $L(BD)<2 S BD=0_BD
S X=$O(^PRCA(347.4,"B",BD,0))
I 'X Q -1
S X=$G(^PRCA(347.4,X,0))
Q X
;
EDT ;Edit bill type
N DA,DIC,DR,Y,DIE
W !,"This option is used to edit the BILL type for converted Bills.",!
EDT1 S DIC="^PRCA(430,",DIC(0)="AEMNQ" D ^DIC Q:+Y<0
S DA=+Y,DIE=DIC,DR=259 D ^DIE
G EDT1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAFBD1 678 printed Sep 11, 2024@01:59:37 Page 2
PRCAFBD1 ;WASH-ISC@ALTOONA,PA/CLH-FMS Billing Document Utilities ;8/2/95 3:19 PM
V ;;4.5;Accounts Receivable;**16**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
DTYPE(BD) ;Return related documents for a BD
+1 ;Input BD type
+2 ;output =bd type^reserved^CR^WR
+3 ;ie: input= 24
+4 ; output=24^1^05^01
+5 NEW X
+6 IF 'BD
QUIT -1
+7 IF $LENGTH(BD)<2
SET BD=0_BD
+8 SET X=$ORDER(^PRCA(347.4,"B",BD,0))
+9 IF 'X
QUIT -1
+10 SET X=$GET(^PRCA(347.4,X,0))
+11 QUIT X
+12 ;
EDT ;Edit bill type
+1 NEW DA,DIC,DR,Y,DIE
+2 WRITE !,"This option is used to edit the BILL type for converted Bills.",!
EDT1 SET DIC="^PRCA(430,"
SET DIC(0)="AEMNQ"
DO ^DIC
if +Y<0
QUIT
+1 SET DA=+Y
SET DIE=DIC
SET DR=259
DO ^DIE
+2 GOTO EDT1
+3 ;
