Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRC5B5

PRC5B5.m

Go to the documentation of this file.
  1. PRC5B5 ;WISC/PLT-Receiver of AAF-document from FMS V5 ; 06/29/94 2:30 PM
  1. V ;;5.1;IFCAP;;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. QUIT ;invalid entry
  1. ;
  1. ;invoked from task manager (see trin^prcosrv2)
  1. ;set accrue y/n in file 442 from AAF-doc.
  1. ;PRCDA=ri of file 423.6 passed
  1. EN ;AAF-message from sever FMS MESSAGE SEVER routine PRCOSRV2
  1. N PRCRI,PRCTY,PRCERR,PRCSEQ,A,B
  1. S PRCRI(423.6)=PRCDA,PRCTY=""
  1. ;check txn message
  1. S PRCERR="",PRCSQE="" D CHECK(PRCRI(423.6))
  1. I PRCERR D G EXIT
  1. . N A,B,C
  1. . S A(1)="IFCAP/FMS AAF MESSAGE IS IN INVALID FORMAT."
  1. . S A(2)="PLEASE CALL FMS-CONVERSION TEAM USER TO RESEND THIS MESSAGE:"
  1. . S A(3)=$P($G(^PRCF(423.6,PRCDA,0)),"^")_" WITH IFCAP ERROR: "_PRCERR
  1. . I PRCTY="" S B(.5)=""
  1. . E S X=$$FIRST^PRC0B1("^PRCF(423.5,""B"""_",""CTL-"_PRCTY_""",",0) S X=$S(X:"G."_$$MG^PRC0B2($P(^PRCF(423.5,X,0),"^",2)),1:.5),B(X)=""
  1. . S C="IFCAP/FMS CONVERSION ERROR MESSAGE-AAF^IFCAP FMS MESSAGE SERVER"
  1. . D MM^PRC0B2(C,"A(",.B)
  1. . QUIT
  1. ;process message
  1. S A=$T(@PRCTY)
  1. D PRO(PRCRI(423.6),$P(A," ",1)_"^"_$P(A,";",3,999))
  1. I PRCERR D G EXIT
  1. . N A,B,C
  1. . S A(1)="IFCAP/FMS CONVERSION MESSAGE "_PRCTY_" PROCESS FAILS"
  1. . S A(2)="PLEASE CALL FMS-CONVERSION TEAM USER TO RESEND THIS MESSAGE:"
  1. . S A(3)=$P($G(^PRCF(423.6,PRCDA,0)),"^")_" WITH IFCAP ERROR: "_PRCERR
  1. . S X=$$FIRST^PRC0B1("^PRCF(423.5,""B"""_",""CTL-"_PRCTY_""",",0) S X=$S(X:"G."_$$MG^PRC0B2($P(^PRCF(423.5,X,0),"^",2)),1:.5),B(X)=""
  1. . S C="IFCAP/FMS COPY ERROR MESSAGE-AAF^IFCAP FMS MESSAGE SERVER"
  1. . D MM^PRC0B2(C,"A(",.B)
  1. . QUIT
  1. ;send processing done message
  1. D
  1. . N A,B,C
  1. . S A(1)="IFCAP/FMS CONVERSION MESSAGE "_PRCTY_" PROCESSING DONE."
  1. . S A(2)=$P($G(^PRCF(423.6,PRCDA,0)),"^")
  1. . S X=$$FIRST^PRC0B1("^PRCF(423.5,""B"""_",""CTL-"_PRCTY_""",",0) S X=$S(X:"G."_$$MG^PRC0B2($P(^PRCF(423.5,X,0),"^",2)),1:.5),B(X)=""
  1. . S C="IFCAP/FMS PROCESS DONE MESSAGE-AAF^IFCAP FMS MESSAGE SERVER"
  1. . D MM^PRC0B2(C,"A(",.B)
  1. . QUIT
  1. ;
  1. EXIT ;delete fms conversion message in file 423.6
  1. D KILL^PRCOSRV3(PRCRI(423.6))
  1. QUIT
  1. ;
  1. CHECK(PRCA,PRCB) ;PRCA=ri of file 423.6, PRCB=^1 txn class from FMS, ^2=description
  1. N PRCC,PRCD,A
  1. S PRCC=$O(^PRCF(423.6,PRCA,1,9999)) I 'PRCC S PRCERR=2 QUIT ;no message
  1. S PRCD=$G(^PRCF(423.6,PRCA,1,PRCC,0)) I PRCD="" S PRCERR=2 QUIT
  1. S PRCTY=$P(PRCD,"^",5),A="" S:PRCTY?1.5A A=$T(@PRCTY)
  1. I $P(PRCD,"^")'="CTL"!(A="") S PRCERR=3,PRCTY="" QUIT ;wrong type
  1. S PRCSEQ=+$P(PRCD,"^",13)_"-"_(+$P(PRCD,"^",14))
  1. F S PRCC=$O(^PRCF(423.6,PRCA,1,PRCC)) Q:'PRCC S PRCD=^(PRCC,0)
  1. I PRCD'="{" S PRCERR=4 QUIT ;missing txn delimeter
  1. QUIT
  1. ;
  1. PRO(PRCA,PRCB) ;PRCA=ri of file 423.6, PRCB=^1 txn class from FMS, ^2=description
  1. N PRCC,PRCD,A,B,X,Y
  1. S PRCC=$O(^PRCF(423.6,PRCA,1,9999))
  1. F S PRCC=$O(^PRCF(423.6,PRCA,1,PRCC)) Q:'PRCC S PRCD=^(PRCC,0) I PRCD?1"AAF".E D
  1. . S A=$P(PRCD,"^",3),A=$P(A," ",1),A=$E(A,1,3)_"-"_$E(A,4,999),B=""
  1. . S:$P(PRCD,"^",4)]"" B=$F("NY",$P(PRCD,"^",4))-2
  1. . S PRCRI(442)=$O(^PRC(442,"B",A,"")) QUIT:'PRCRI(442)
  1. . D EDIT^PRC0B(.X,"442;^PRC(442,;"_PRCRI(442),"30////"_B)
  1. . QUIT
  1. QUIT
  1. ;
  1. ;
  1. AAF ;;AUTO-ACCRUE DATA
  1. ;