| [613] | 1 | PRCFACX0 ;WISC@ALTOONA/CTB-CODE SHEET STRING GENERATOR CONTINUED ;6/30/93  10:34
 | 
|---|
 | 2 | V ;;5.1;IFCAP;;Oct 20, 2000
 | 
|---|
 | 3 |  ;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
 | 4 |  S DA=PRCFA("CSDA")
 | 
|---|
 | 5 |  I '$D(PRC("PER")) D DUZ^PRCFSITE Q:'%  ; Line moved 2/3/93 - LEM
 | 
|---|
 | 6 |  D SIG K PRCFK I $D(PRCFA("SIGFAIL")) K PRCFA("SIGFAIL") G DEL^PRCFACXM
 | 
|---|
 | 7 |  I '$D(PRC("PER")) D DUZ^PRCFSITE Q:'%
 | 
|---|
 | 8 |  S $P(Q(0),"^",8)=+PRC("PER")
 | 
|---|
 | 9 |  S:$D(P)#2 PX=P
 | 
|---|
 | 10 |  S DA=PRCFA("CSDA")
 | 
|---|
 | 11 |  S MESSAGE=""
 | 
|---|
 | 12 |  D REMOVE^PRCFES1(DA)
 | 
|---|
 | 13 |  D ENCODE^PRCFES1(DA,DUZ,.MESSAGE)
 | 
|---|
 | 14 |  K MESSAGE
 | 
|---|
 | 15 |  I $D(PRCFA("PODA")),+PRCFA("PODA")>0 S DA=PRCFA("PODA") S POESIG=1
 | 
|---|
 | 16 |  K P S:$D(PX) P=PX
 | 
|---|
 | 17 |  K TT,BTYPE,DR I $D(Q(0)),$P(Q(0),"^",4)]"" S TT=$P(Q(0),"^",4)*100 I TT<90000 K TT
 | 
|---|
 | 18 |  I $D(PRCFA("TTDA")),PRCFA("TTDA")]"",$D(^PRCD(420.4,PRCFA("TTDA"),0)),+$P(^(0),"^",4)>0 S BTYPE=$P(^(0),"^",4) I '$D(^PRCF(423.9,BTYPE,0)) K BTYPE
 | 
|---|
 | 19 |  I $D(BTYPE) S BTYPE=$P(^PRCF(423.9,BTYPE,0),"^",1) I ("^FEE^FEN^"[("^"_BTYPE_"^")) S BTYPE=$$FB^PRCS58
 | 
|---|
 | 20 |  I $D(PRCABN),$D(^PRCA(430,PRCABN,0)),",22,23,"[(","_$P(^(0),"^",2)_",") S DR=".5///TODAY;.6///OTHER;.3////N;.8///3" G OV
 | 
|---|
 | 21 |  S DR=".5//TODAY;.6"_$S($D(BTYPE):"//"_BTYPE,$D(PRCHLOG):"//LOG",1:"//OTHER")_";.3////N;.8//3"
 | 
|---|
 | 22 | OV ;
 | 
|---|
 | 23 |  K TT,BTYPE S DIE="^PRCF(423,",DA=PRCFA("CSDA") S:'$D(DR) DR="[PRCFACEDIT]" D ^DIE I $D(Y)'=0 G DEL^PRCFACXM
 | 
|---|
 | 24 |  W !! D:'$D(PRCFA("PODA")) Q14 D EN7^PRCFAC1 S PRCFA("CSDA")=DA I '$D(PRCFA("ARCS")),$D(PRCFA("PODA")),PRCFA("PODA")>0 D:'$D(PRCFA("PAYMENT")) ^PRCEFIS4
 | 
|---|
 | 25 |  S DA=PRCFA("CSDA") G OUT:$P(PRC("PARAM"),"^",17)'["Y",OUT:PRCFASYS'["CLM"
 | 
|---|
 | 26 |  I PRCFASYS'["CLM" G OUT
 | 
|---|
 | 27 |  S %A="Do you wish to post this information to the Fiscal Status of Funds Tracker",%B="If you answer 'YES', you will be asked the information necessary to post"
 | 
|---|
 | 28 |  S %B(1)="the code sheet to the Fiscal Status of Funds.  A 'NO' or an '^' will",%B(2)="skip the bypass the posting.",%=2
 | 
|---|
 | 29 |  D ^PRCFYN G:%'=1 OUT D EN5^PRCFAC1 G OUT
 | 
|---|
 | 30 | Q14 S DIC=442,DIC(0)="MNZ",X=^PRCF(423,PRCFA("CSDA"),0),X=$P(X,"^",2)_"-"_$P(X,"^",6) D ^DIC K DIC I Y>0 S PO=Y,PO(0)=Y(0),PRCFA("PODA")=+Y Q
 | 
|---|
 | 31 |  Q
 | 
|---|
 | 32 | OUT K A,B,D,D0,D1,DG,DIC,DIE,DIG,DIH,DIU,DIV,DIW,DLAYGO,DR,I,J,K,N,O,PRCFA("ARCS"),Q,Q1,S,X,X1,XL1,Y,DI,DQ,PRCFCS Q
 | 
|---|
 | 33 |  Q
 | 
|---|
 | 34 | SIG N MESSAGE S MESSAGE=""
 | 
|---|
 | 35 |  D ESIG^PRCUESIG(DUZ,.MESSAGE)
 | 
|---|
 | 36 |  G:(MESSAGE=0)!(MESSAGE=-3) FAIL
 | 
|---|
 | 37 |  I (MESSAGE=-1)!(MESSAGE=-2) S PRCFA("SIGFAIL")="" Q
 | 
|---|
 | 38 |  ;
 | 
|---|
 | 39 |  ;THE FOLLOWING LINE IS NEEDED TO PASS X, IF PRCFA("SIGFAIL") IS
 | 
|---|
 | 40 |  ;NOT SET, TO THE A/R PACKAGE.  THIS LINE CAN BE DELETED AFTER A/R
 | 
|---|
 | 41 |  ;RELEASES A/R V4.0--->PRCAOFF1 OF A/R CALLS SIG^PRCFACX0.
 | 
|---|
 | 42 |  ;
 | 
|---|
 | 43 |  I MESSAGE=1 S X=$P($G(^VA(200,+DUZ,20)),"^",4)
 | 
|---|
 | 44 |  ;
 | 
|---|
 | 45 |  Q
 | 
|---|
 | 46 | FAIL W !,"  ",$C(7),"SIGNATURE CODE FAILURE " S PRCFA("SIGFAIL")="" Q
 | 
|---|
 | 47 |  Q
 | 
|---|