RCFMDRV1.m

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 ---RCFMDRV1   1144     printed  Apr 09, 2024@20:46:24                                                                                                                                                                                                    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