- RCFMDRV1 ;WASH-ISC@ALTOONA,PA/RGY-Add FMS document ;8/18/94 11:36 AM
- V ;;4.5;Accounts Receivable;;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- OPEN(DOC,TYPE,ID,ENT,ERROR,BILL,EVN,BAT) ;Add event to FMS document file
- NEW DIC,D0,DIE,DA,X,DLAYGO,DR,DEBT,DIS,DINUM,RCOK
- S ERROR="",ENT=-1
- I $G(DOC)="" S ERROR="FMS Document number undefined" Q
- I $G(ID)]"",$D(^RC(347,"D",ID)) S ERROR="Duplicate Identifier requested" Q
- I '$D(^RC(347.1,+$G(TYPE),0)) S ERROR="Unknown type of document" Q
- I $G(BILL)]"",'$D(^PRCA(430,BILL,0)) S ERROR="Bill number does not exist" Q
- I $G(EVN)]"",'$D(^PRCA(433,EVN,0)) S ERROR="Event number does not exist" Q
- ;S:DOC["-" DOC=$P(DOC,"-")_$P(DOC,"-",2) ;CLH - to allowfull fms number to be entered
- F ENT=+$P(^RC(347,0),"^",3)+1:1 L +^RC(347,ENT):0 I $T S RCOK=0 D L -^RC(347,ENT) Q:RCOK
- .I $D(^RC(347,ENT)) Q
- .S DINUM=ENT,DIC="^RC(347,",DIC(0)="L",DLAYGO=347,X=ENT
- .K DD,DO D FILE^DICN K DIC,DLAYGO,DO
- .I Y<0 S ERROR="Unable to add bill to bill file!" Q
- .S DIE="^RC(347,",DR="[RCFM OPEN DOCUMENT]",(ENT,DA)=+Y D ^DIE
- .S RCOK=1
- .Q
- Q Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCFMDRV1 1144 printed Jan 18, 2025@02:48:05 Page 2
- RCFMDRV1 ;WASH-ISC@ALTOONA,PA/RGY-Add FMS document ;8/18/94 11:36 AM
- V ;;4.5;Accounts Receivable;;Mar 20, 1995
- +1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- OPEN(DOC,TYPE,ID,ENT,ERROR,BILL,EVN,BAT) ;Add event to FMS document file
- +1 NEW DIC,D0,DIE,DA,X,DLAYGO,DR,DEBT,DIS,DINUM,RCOK
- +2 SET ERROR=""
- SET ENT=-1
- +3 IF $GET(DOC)=""
- SET ERROR="FMS Document number undefined"
- QUIT
- +4 IF $GET(ID)]""
- IF $DATA(^RC(347,"D",ID))
- SET ERROR="Duplicate Identifier requested"
- QUIT
- +5 IF '$DATA(^RC(347.1,+$GET(TYPE),0))
- SET ERROR="Unknown type of document"
- QUIT
- +6 IF $GET(BILL)]""
- IF '$DATA(^PRCA(430,BILL,0))
- SET ERROR="Bill number does not exist"
- QUIT
- +7 IF $GET(EVN)]""
- IF '$DATA(^PRCA(433,EVN,0))
- SET ERROR="Event number does not exist"
- QUIT
- +8 ;S:DOC["-" DOC=$P(DOC,"-")_$P(DOC,"-",2) ;CLH - to allowfull fms number to be entered
- +9 FOR ENT=+$PIECE(^RC(347,0),"^",3)+1:1
- LOCK +^RC(347,ENT):0
- IF $TEST
- SET RCOK=0
- Begin DoDot:1
- +10 IF $DATA(^RC(347,ENT))
- QUIT
- +11 SET DINUM=ENT
- SET DIC="^RC(347,"
- SET DIC(0)="L"
- SET DLAYGO=347
- SET X=ENT
- +12 KILL DD,DO
- DO FILE^DICN
- KILL DIC,DLAYGO,DO
- +13 IF Y<0
- SET ERROR="Unable to add bill to bill file!"
- QUIT
- +14 SET DIE="^RC(347,"
- SET DR="[RCFM OPEN DOCUMENT]"
- SET (ENT,DA)=+Y
- DO ^DIE
- +15 SET RCOK=1
- +16 QUIT
- End DoDot:1
- LOCK -^RC(347,ENT)
- if RCOK
- QUIT
- Q QUIT