- PRCFACX0 ;WISC@ALTOONA/CTB-CODE SHEET STRING GENERATOR CONTINUED ;6/30/93 10:34
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- S DA=PRCFA("CSDA")
- I '$D(PRC("PER")) D DUZ^PRCFSITE Q:'% ; Line moved 2/3/93 - LEM
- D SIG K PRCFK I $D(PRCFA("SIGFAIL")) K PRCFA("SIGFAIL") G DEL^PRCFACXM
- I '$D(PRC("PER")) D DUZ^PRCFSITE Q:'%
- S $P(Q(0),"^",8)=+PRC("PER")
- S:$D(P)#2 PX=P
- S DA=PRCFA("CSDA")
- S MESSAGE=""
- D REMOVE^PRCFES1(DA)
- D ENCODE^PRCFES1(DA,DUZ,.MESSAGE)
- K MESSAGE
- I $D(PRCFA("PODA")),+PRCFA("PODA")>0 S DA=PRCFA("PODA") S POESIG=1
- K P S:$D(PX) P=PX
- K TT,BTYPE,DR I $D(Q(0)),$P(Q(0),"^",4)]"" S TT=$P(Q(0),"^",4)*100 I TT<90000 K TT
- 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
- I $D(BTYPE) S BTYPE=$P(^PRCF(423.9,BTYPE,0),"^",1) I ("^FEE^FEN^"[("^"_BTYPE_"^")) S BTYPE=$$FB^PRCS58
- 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
- S DR=".5//TODAY;.6"_$S($D(BTYPE):"//"_BTYPE,$D(PRCHLOG):"//LOG",1:"//OTHER")_";.3////N;.8//3"
- OV ;
- K TT,BTYPE S DIE="^PRCF(423,",DA=PRCFA("CSDA") S:'$D(DR) DR="[PRCFACEDIT]" D ^DIE I $D(Y)'=0 G DEL^PRCFACXM
- 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
- S DA=PRCFA("CSDA") G OUT:$P(PRC("PARAM"),"^",17)'["Y",OUT:PRCFASYS'["CLM"
- I PRCFASYS'["CLM" G OUT
- 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"
- 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
- D ^PRCFYN G:%'=1 OUT D EN5^PRCFAC1 G OUT
- 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
- Q
- 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
- Q
- SIG N MESSAGE S MESSAGE=""
- D ESIG^PRCUESIG(DUZ,.MESSAGE)
- G:(MESSAGE=0)!(MESSAGE=-3) FAIL
- I (MESSAGE=-1)!(MESSAGE=-2) S PRCFA("SIGFAIL")="" Q
- ;
- ;THE FOLLOWING LINE IS NEEDED TO PASS X, IF PRCFA("SIGFAIL") IS
- ;NOT SET, TO THE A/R PACKAGE. THIS LINE CAN BE DELETED AFTER A/R
- ;RELEASES A/R V4.0--->PRCAOFF1 OF A/R CALLS SIG^PRCFACX0.
- ;
- I MESSAGE=1 S X=$P($G(^VA(200,+DUZ,20)),"^",4)
- ;
- Q
- FAIL W !," ",$C(7),"SIGNATURE CODE FAILURE " S PRCFA("SIGFAIL")="" Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFACX0 2632 printed Jan 18, 2025@03:03:29 Page 2
- PRCFACX0 ;WISC@ALTOONA/CTB-CODE SHEET STRING GENERATOR CONTINUED ;6/30/93 10:34
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 SET DA=PRCFA("CSDA")
- +3 ; Line moved 2/3/93 - LEM
- IF '$DATA(PRC("PER"))
- DO DUZ^PRCFSITE
- if '%
- QUIT
- +4 DO SIG
- KILL PRCFK
- IF $DATA(PRCFA("SIGFAIL"))
- KILL PRCFA("SIGFAIL")
- GOTO DEL^PRCFACXM
- +5 IF '$DATA(PRC("PER"))
- DO DUZ^PRCFSITE
- if '%
- QUIT
- +6 SET $PIECE(Q(0),"^",8)=+PRC("PER")
- +7 if $DATA(P)#2
- SET PX=P
- +8 SET DA=PRCFA("CSDA")
- +9 SET MESSAGE=""
- +10 DO REMOVE^PRCFES1(DA)
- +11 DO ENCODE^PRCFES1(DA,DUZ,.MESSAGE)
- +12 KILL MESSAGE
- +13 IF $DATA(PRCFA("PODA"))
- IF +PRCFA("PODA")>0
- SET DA=PRCFA("PODA")
- SET POESIG=1
- +14 KILL P
- if $DATA(PX)
- SET P=PX
- +15 KILL TT,BTYPE,DR
- IF $DATA(Q(0))
- IF $PIECE(Q(0),"^",4)]""
- SET TT=$PIECE(Q(0),"^",4)*100
- IF TT<90000
- KILL TT
- +16 IF $DATA(PRCFA("TTDA"))
- IF PRCFA("TTDA")]""
- IF $DATA(^PRCD(420.4,PRCFA("TTDA"),0))
- IF +$PIECE(^(0),"^",4)>0
- SET BTYPE=$PIECE(^(0),"^",4)
- IF '$DATA(^PRCF(423.9,BTYPE,0))
- KILL BTYPE
- +17 IF $DATA(BTYPE)
- SET BTYPE=$PIECE(^PRCF(423.9,BTYPE,0),"^",1)
- IF ("^FEE^FEN^"[("^"_BTYPE_"^"))
- SET BTYPE=$$FB^PRCS58
- +18 IF $DATA(PRCABN)
- IF $DATA(^PRCA(430,PRCABN,0))
- IF ",22,23,"[(","_$PIECE(^(0),"^",2)_",")
- SET DR=".5///TODAY;.6///OTHER;.3////N;.8///3"
- GOTO OV
- +19 SET DR=".5//TODAY;.6"_$SELECT($DATA(BTYPE):"//"_BTYPE,$DATA(PRCHLOG):"//LOG",1:"//OTHER")_";.3////N;.8//3"
- OV ;
- +1 KILL TT,BTYPE
- SET DIE="^PRCF(423,"
- SET DA=PRCFA("CSDA")
- if '$DATA(DR)
- SET DR="[PRCFACEDIT]"
- DO ^DIE
- IF $DATA(Y)'=0
- GOTO DEL^PRCFACXM
- +2 WRITE !!
- if '$DATA(PRCFA("PODA"))
- DO Q14
- DO EN7^PRCFAC1
- SET PRCFA("CSDA")=DA
- IF '$DATA(PRCFA("ARCS"))
- IF $DATA(PRCFA("PODA"))
- IF PRCFA("PODA")>0
- if '$DATA(PRCFA("PAYMENT"))
- DO ^PRCEFIS4
- +3 SET DA=PRCFA("CSDA")
- if $PIECE(PRC("PARAM"),"^",17)'["Y"
- GOTO OUT
- if PRCFASYS'["CLM"
- GOTO OUT
- +4 IF PRCFASYS'["CLM"
- GOTO OUT
- +5 SET %A="Do you wish to post this information to the Fiscal Status of Funds Tracker"
- SET %B="If you answer 'YES', you will be asked the information necessary to post"
- +6 SET %B(1)="the code sheet to the Fiscal Status of Funds. A 'NO' or an '^' will"
- SET %B(2)="skip the bypass the posting."
- SET %=2
- +7 DO ^PRCFYN
- if %'=1
- GOTO OUT
- DO EN5^PRCFAC1
- GOTO OUT
- Q14 SET DIC=442
- SET DIC(0)="MNZ"
- SET X=^PRCF(423,PRCFA("CSDA"),0)
- SET X=$PIECE(X,"^",2)_"-"_$PIECE(X,"^",6)
- DO ^DIC
- KILL DIC
- IF Y>0
- SET PO=Y
- SET PO(0)=Y(0)
- SET PRCFA("PODA")=+Y
- QUIT
- +1 QUIT
- OUT KILL 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
- QUIT
- +1 QUIT
- SIG NEW MESSAGE
- SET MESSAGE=""
- +1 DO ESIG^PRCUESIG(DUZ,.MESSAGE)
- +2 if (MESSAGE=0)!(MESSAGE=-3)
- GOTO FAIL
- +3 IF (MESSAGE=-1)!(MESSAGE=-2)
- SET PRCFA("SIGFAIL")=""
- QUIT
- +4 ;
- +5 ;THE FOLLOWING LINE IS NEEDED TO PASS X, IF PRCFA("SIGFAIL") IS
- +6 ;NOT SET, TO THE A/R PACKAGE. THIS LINE CAN BE DELETED AFTER A/R
- +7 ;RELEASES A/R V4.0--->PRCAOFF1 OF A/R CALLS SIG^PRCFACX0.
- +8 ;
- +9 IF MESSAGE=1
- SET X=$PIECE($GET(^VA(200,+DUZ,20)),"^",4)
- +10 ;
- +11 QUIT
- FAIL WRITE !," ",$CHAR(7),"SIGNATURE CODE FAILURE "
- SET PRCFA("SIGFAIL")=""
- QUIT
- +1 QUIT