- RCFMFN02 ;WASH-ISC@ATLOONA,PA/RGY-Return information for FMS Document processing ;8/27/94 8:40 PM
- V ;;4.5;Accounts Receivable;**114,204,173**;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- DEL(ID) ;Delete entry from DOCUMENT file (347)
- NEW DA
- I '$D(ID) Q
- S DA=+$O(^RC(347,"C",ID,0)) S:'DA DA=+$O(^RC(347,"D",ID,0))
- I '$D(^RC(347,DA,0)) Q
- D DEL^RCFMPUR(DA)
- Q
- SSTAT(ID,STAT) ;Set status for DOCUMENT file (347)
- NEW %DT,D,D0,DA,DI,DIC,DIE,DQ,DR,X
- I '$D(ID) Q
- S DA=+$O(^RC(347,"C",ID,0)) S:'DA DA=+$O(^RC(347,"D",ID,0))
- I '$D(^RC(347,DA,0)) Q
- I ",0,1,2,3,"'[(","_$G(STAT)_",") Q
- S DIE="^RC(347,",DR=".05///^S X=""NOW"";.03////^S X="_STAT D ^DIE
- ;Update the FMS TRAMSISSION DATE in files 430 and 347
- S FMSDT=$S($G(FMSDT):FMSDT,1:DT)
- ;DA is already set above
- I $D(^RC(347,DA,2)) K ^RC(347,"FMS",^RC(347,DA,2),DA)
- S ^RC(347,DA,2)=FMSDT,^RC(347,"FMS",FMSDT,DA)=""
- ;need to set DA for file 430... from the AR Bill number from file 347.
- S DA=$P($G(^RC(347,DA,0)),"^",7) I DA D
- .I $D(^PRCA(430,DA,203)) K ^PRCA(430,"FMS",^PRCA(430,DA,203),DA)
- .S ^PRCA(430,DA,203)=FMSDT,^PRCA(430,"FMS",FMSDT,DA)=""
- Q
- GSTAT(ID) ;Get status for DOCUMENT file (347)
- NEW DA
- I '$D(ID) Q -1
- S DA=+$O(^RC(347,"C",ID,0)) S:'DA DA=+$O(^RC(347,"D",ID,0))
- I '$D(^RC(347,DA,0)) Q -1
- Q $P(^RC(347,DA,0),"^",3)
- RETN(ID,ST) ;Process return document from stacker
- NEW DA
- I '$D(ID) Q
- ;line removed to accomodate full fms doc number - CLH
- S ST=$G(ST),ST=$S(ST="A":2,ST="R":3,1:-1)
- I ST<0 Q
- ; if a CR document and it rejects, send message to users
- I $S($E(ID,1,3)="CR-":1,$E(ID,1,3)="TR-":1,1:0),ST=3 D MAILREJ(ID)
- D SSTAT(ID,ST)
- Q
- STSTAT(DA,ST) ;set processed status in 433 (used for summary docs)
- Q:'$D(DA)
- Q:'$D(ST)
- Q:'$D(^PRCA(433,DA,0))
- N DIE,DR
- S DIE="^PRCA(433,",DR="91///^S X="_ST D ^DIE
- Q
- GTSTAT(DA) ;function to return transaction status
- I DA<0 Q -1
- I '$D(^PRCA(433,DA,8)) Q -1
- Q $P(^PRCA(433,DA,0),U,9)
- ;
- ;
- MAILREJ(DOCUMENT) ; mail reject message to user to ask for retransmission
- N MESSAGE,RECEIPT,XCNP,XMDUZ,XMZ,RCCR
- S RCCR=$S($E(DOCUMENT,1,3)="CR-":1,$E(DOCUMENT,1,4)="TR-":2,1:0)
- S MESSAGE(1)="The following "_$E(DOCUMENT,1,2)_" FMS document rejected and needs to be retransmitted."
- S MESSAGE(2)=" "
- S MESSAGE(3)=" Document: "_DOCUMENT
- S MESSAGE(4)=" "
- ; show information for cash receipt/transfer receipt for EDI document
- I RCCR D
- . S MESSAGE(5)="You may regenerate this "_$P("cash^transfer",U,RCCR)_" receipt document by selecting the"
- . S MESSAGE(6)="option Process Receipt (PR) located under the Receipt Processing"
- . S MESSAGE(7)="Listmanager screen."
- . S RECEIPT=$P($G(^RCY(344,+$O(^RCY(344,"ADOC",DOCUMENT,0)),0)),"^")
- . I RECEIPT'="" S MESSAGE(8)=" ",MESSAGE(9)=" This "_$P("cash^transfer",U,RCCR)_" receipt document was generated by receipt "_RECEIPT_"."
- ;
- S XMTEXT="MESSAGE("
- S XMSUB="FMS "_$S(RCCR'=2:"Cash",1:"Transfer")_" Receipt Document Rejected"
- S XMDUZ="AR Package",XMY("G.RCDP PAYMENTS")=""
- D ^XMD
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCFMFN02 3085 printed Feb 18, 2025@23:13:16 Page 2
- RCFMFN02 ;WASH-ISC@ATLOONA,PA/RGY-Return information for FMS Document processing ;8/27/94 8:40 PM
- V ;;4.5;Accounts Receivable;**114,204,173**;Mar 20, 1995
- +1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- DEL(ID) ;Delete entry from DOCUMENT file (347)
- +1 NEW DA
- +2 IF '$DATA(ID)
- QUIT
- +3 SET DA=+$ORDER(^RC(347,"C",ID,0))
- if 'DA
- SET DA=+$ORDER(^RC(347,"D",ID,0))
- +4 IF '$DATA(^RC(347,DA,0))
- QUIT
- +5 DO DEL^RCFMPUR(DA)
- +6 QUIT
- SSTAT(ID,STAT) ;Set status for DOCUMENT file (347)
- +1 NEW %DT,D,D0,DA,DI,DIC,DIE,DQ,DR,X
- +2 IF '$DATA(ID)
- QUIT
- +3 SET DA=+$ORDER(^RC(347,"C",ID,0))
- if 'DA
- SET DA=+$ORDER(^RC(347,"D",ID,0))
- +4 IF '$DATA(^RC(347,DA,0))
- QUIT
- +5 IF ",0,1,2,3,"'[(","_$GET(STAT)_",")
- QUIT
- +6 SET DIE="^RC(347,"
- SET DR=".05///^S X=""NOW"";.03////^S X="_STAT
- DO ^DIE
- +7 ;Update the FMS TRAMSISSION DATE in files 430 and 347
- +8 SET FMSDT=$SELECT($GET(FMSDT):FMSDT,1:DT)
- +9 ;DA is already set above
- +10 IF $DATA(^RC(347,DA,2))
- KILL ^RC(347,"FMS",^RC(347,DA,2),DA)
- +11 SET ^RC(347,DA,2)=FMSDT
- SET ^RC(347,"FMS",FMSDT,DA)=""
- +12 ;need to set DA for file 430... from the AR Bill number from file 347.
- +13 SET DA=$PIECE($GET(^RC(347,DA,0)),"^",7)
- IF DA
- Begin DoDot:1
- +14 IF $DATA(^PRCA(430,DA,203))
- KILL ^PRCA(430,"FMS",^PRCA(430,DA,203),DA)
- +15 SET ^PRCA(430,DA,203)=FMSDT
- SET ^PRCA(430,"FMS",FMSDT,DA)=""
- End DoDot:1
- +16 QUIT
- GSTAT(ID) ;Get status for DOCUMENT file (347)
- +1 NEW DA
- +2 IF '$DATA(ID)
- QUIT -1
- +3 SET DA=+$ORDER(^RC(347,"C",ID,0))
- if 'DA
- SET DA=+$ORDER(^RC(347,"D",ID,0))
- +4 IF '$DATA(^RC(347,DA,0))
- QUIT -1
- +5 QUIT $PIECE(^RC(347,DA,0),"^",3)
- RETN(ID,ST) ;Process return document from stacker
- +1 NEW DA
- +2 IF '$DATA(ID)
- QUIT
- +3 ;line removed to accomodate full fms doc number - CLH
- +4 SET ST=$GET(ST)
- SET ST=$SELECT(ST="A":2,ST="R":3,1:-1)
- +5 IF ST<0
- QUIT
- +6 ; if a CR document and it rejects, send message to users
- +7 IF $SELECT($EXTRACT(ID,1,3)="CR-":1,$EXTRACT(ID,1,3)="TR-":1,1:0)
- IF ST=3
- DO MAILREJ(ID)
- +8 DO SSTAT(ID,ST)
- +9 QUIT
- STSTAT(DA,ST) ;set processed status in 433 (used for summary docs)
- +1 if '$DATA(DA)
- QUIT
- +2 if '$DATA(ST)
- QUIT
- +3 if '$DATA(^PRCA(433,DA,0))
- QUIT
- +4 NEW DIE,DR
- +5 SET DIE="^PRCA(433,"
- SET DR="91///^S X="_ST
- DO ^DIE
- +6 QUIT
- GTSTAT(DA) ;function to return transaction status
- +1 IF DA<0
- QUIT -1
- +2 IF '$DATA(^PRCA(433,DA,8))
- QUIT -1
- +3 QUIT $PIECE(^PRCA(433,DA,0),U,9)
- +4 ;
- +5 ;
- MAILREJ(DOCUMENT) ; mail reject message to user to ask for retransmission
- +1 NEW MESSAGE,RECEIPT,XCNP,XMDUZ,XMZ,RCCR
- +2 SET RCCR=$SELECT($EXTRACT(DOCUMENT,1,3)="CR-":1,$EXTRACT(DOCUMENT,1,4)="TR-":2,1:0)
- +3 SET MESSAGE(1)="The following "_$EXTRACT(DOCUMENT,1,2)_" FMS document rejected and needs to be retransmitted."
- +4 SET MESSAGE(2)=" "
- +5 SET MESSAGE(3)=" Document: "_DOCUMENT
- +6 SET MESSAGE(4)=" "
- +7 ; show information for cash receipt/transfer receipt for EDI document
- +8 IF RCCR
- Begin DoDot:1
- +9 SET MESSAGE(5)="You may regenerate this "_$PIECE("cash^transfer",U,RCCR)_" receipt document by selecting the"
- +10 SET MESSAGE(6)="option Process Receipt (PR) located under the Receipt Processing"
- +11 SET MESSAGE(7)="Listmanager screen."
- +12 SET RECEIPT=$PIECE($GET(^RCY(344,+$ORDER(^RCY(344,"ADOC",DOCUMENT,0)),0)),"^")
- +13 IF RECEIPT'=""
- SET MESSAGE(8)=" "
- SET MESSAGE(9)=" This "_$PIECE("cash^transfer",U,RCCR)_" receipt document was generated by receipt "_RECEIPT_"."
- End DoDot:1
- +14 ;
- +15 SET XMTEXT="MESSAGE("
- +16 SET XMSUB="FMS "_$SELECT(RCCR'=2:"Cash",1:"Transfer")_" Receipt Document Rejected"
- +17 SET XMDUZ="AR Package"
- SET XMY("G.RCDP PAYMENTS")=""
- +18 DO ^XMD
- +19 QUIT