| [613] | 1 | PRCFACX2 ;WISC/CTB/CLH-PASS STRING TO CODE SHEET ;6/4/93 13:21
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;BUILD AND TRANSMIT CODE SHEET AS KEY PUNCH STYLE
|
|---|
| 5 | ;VARIABLES REQUIRED
|
|---|
| 6 | ;PRCFASYS - SYSTEM ID
|
|---|
| 7 | ;PRCFA("TTF") - TRANSACTION TYPE - .01 FIELD FROM FILE 420.4
|
|---|
| 8 | ;PRC("SITE")
|
|---|
| 9 | ;PRC("PER")-STANDARD PERSON VARIABLE - ZERO NODE OF PERSON FILE
|
|---|
| 10 | ;PRCFA("STRING")-CODE SHEET STRING TO BE TRANSMITTED
|
|---|
| 11 | ;PRCFA("STRING",#)-ARRAY OF ADDITIONAL CODE SHEET LINES TO BE TRANSMITTED (OPTIONAL)
|
|---|
| 12 | ;^TMP($J,"STRING",$)-ARRAY OF ADDITIONAL CODE SHEET LINES TO BE TRANSAMITTED (OPTIONAL)
|
|---|
| 13 | ;OPTIONAL VARIABLES
|
|---|
| 14 | ;PRCF("TDATE") - TRANSMISSION DATE (OPTIONAL - IF UNDEFINED, USES CURRENT DATE
|
|---|
| 15 | ;PRCFA("REF")- LOG COMMON NUMBER
|
|---|
| 16 | ;PRCFA("PRIO") - BATCH PRIORITY - IF UNDEFINED SYSTEM DEFAULTS TO 3
|
|---|
| 17 | N %,I,X,B,%H,%I,%DT,D,D0,DA,DI,DIC,DIE,DQ,DR,N,P
|
|---|
| 18 | I $S('$D(PRCFASYS):1,PRCFASYS="":1,1:0) S PRCFASYS=""
|
|---|
| 19 | I $S('$D(PRCFA("TTF")):1,PRCFA("TTF")="":1,'$D(PRC("SITE")):1,PRC("SITE")="":1,'$D(PRC("PER")):1,PRC("PER")="":1,'$D(PRCFA("STRING")):1,PRCFA("STRING")="":1,1:0) S %=0 Q
|
|---|
| 20 | D TT^PRCFAC K PRCFA("TTF") Q:'% S PRCFA("EDIT")="",PRCHAUTO="",PRCFA("KP")="" D NEWCS^PRCFAC K PRCHAUTO,PRCFA("KP") I '$D(PRCFA("CSNAME")) S %=0 Q
|
|---|
| 21 | S DA=PRCFA("CSDA")
|
|---|
| 22 | S MESSAGE=""
|
|---|
| 23 | D ENCODE^PRCFES1(DA,DUZ,.MESSAGE)
|
|---|
| 24 | K MESSAGE
|
|---|
| 25 | K BTYPE 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
|
|---|
| 26 | I $D(BTYPE) S BTYPE=$P(^PRCF(423.9,BTYPE,0),"^",1) I ("^FEE^FEN^"[("^"_BTYPE_"^")) S BTYPE=$$FB^PRCS58
|
|---|
| 27 | I $D(PRCF("TDATE")),PRCF("TDATE")]"" S X=PRCF("TDATE")
|
|---|
| 28 | E S X="TODAY"
|
|---|
| 29 | S DR=".31////1;.5///"_X_";.6"_$S($D(BTYPE):"///"_BTYPE,$D(PRCHLOG):"///LOG",1:"///OTHER")_";.3///N;.8///"_$S($D(PRCFA("PRIO"))["0":3,"2~3~4"[PRCFA("PRIO"):PRCFA("PRIO"),1:3) K PRCFA("PRIO")
|
|---|
| 30 | K TT,BTYPE S DIE="^PRCF(423,",DA=PRCFA("CSDA") D ^DIE I $D(Y)'=0 D DEL^PRCFACXM S %=0 Q
|
|---|
| 31 | S I=1 I $D(PRCFA("STRING"))#10 S ^PRCF(423,DA,"CODE",1,0)=PRCFA("STRING"),I=I+1
|
|---|
| 32 | S %=0 F I=I:1 S %=$O(PRCFA("STRING",%)) Q:'% S ^PRCF(423,DA,"CODE",I,0)=PRCFA("STRING",%)
|
|---|
| 33 | S %=0 F I=I:1 S %=$O(^TMP($J,"STRING",%)) Q:'% S ^PRCF(423,DA,"CODE",I,0)=^TMP($J,"STRING",%)
|
|---|
| 34 | S ^PRCF(423,DA,"CODE",0)="^423.06^"_(I-1)_"^"_(I-1)
|
|---|
| 35 | S %=1 Q
|
|---|
