| [613] | 1 | PRCFACXM ;WISC@ALTOONA/CTB-CODE SHEET STRING GENERATOR ;4/26/93 2:49 PM ; 4/26/93 11:48 AM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D ^PRCFACX1
|
|---|
| 5 | XM S PRCFX=+$P(^PRCF(423,PRCFA("CSDA"),"TRANS"),"^",15)
|
|---|
| 6 | W !!,"TRANSMITTED CODE SHEET WILL BE AS FOLLOWS:" I 'PRCFX W !
|
|---|
| 7 | ;'$D(PRCHLOG),PRCFA("SYS")'="CAP" W !
|
|---|
| 8 | E W !," 1 2 3 4 5 6 7 8" S Y="",$P(Y,"1234567890",9)="" W !,Y S Y="",$P(Y,"----+----|",9)="" W !,Y
|
|---|
| 9 | S X="",X1=0 F I=1:1 S X=$O(PRCFCS(X)) Q:X="" W !,PRCFCS(X) S X1=X1+$L(PRCFCS(X))
|
|---|
| 10 | I PRCFX I X1'=PRCFX W !!,$C(7),"Code sheet does not equal "_PRCFX_" characters.",! G EDIT
|
|---|
| 11 | W ! S %A="Do you wish to TRANSMIT this Code Sheet to "_$S(PRCFA("SYS")="ISM":"ISMS",1:"LOG")
|
|---|
| 12 | S %=1,%B="'YES' will mark the code sheet for transmission.",%B(1)="'NO' will give you a chance to edit the code sheet."
|
|---|
| 13 | S %B(2)="'^' will delete the code sheet." D ^PRCFYN G:%=1 TRANSMIT G:%<0 DEL
|
|---|
| 14 | EDIT S %A="Do you want to edit this Code Sheet",%B="'YES' to edit, 'NO' or '^' for chance to delete code sheet."
|
|---|
| 15 | S %=2 D ^PRCFYN I %'=1 S DA=PRCFA("CSDA") D DEL Q
|
|---|
| 16 | S DA=PRCFA("CSDA"),DIE="^PRCF(423," K PRCFCS
|
|---|
| 17 | S DR="" S:$D(PRCFA("EDIT")) DR=PRCFA("EDIT")
|
|---|
| 18 | I $D(PRCFA("CSNAME")),PRCFA("CSNAME")["KP" S DR=112
|
|---|
| 19 | I DR="" W !,"Error in editing this code sheet. Please re-enter.",$C(7) G DEL
|
|---|
| 20 | D ^DIE I DR=112 D RE1^PRCFACR3,XM^PRCFACR3 G XM
|
|---|
| 21 | G V
|
|---|
| 22 | TRANSMIT G:'$D(^PRCF(423,DA,"TRANS")) ^PRCFACX0
|
|---|
| 23 | I $D(^PRCF(423,DA,"TRANS")),$P(^("TRANS"),U,1)'="Y" G ^PRCFACX0
|
|---|
| 24 | W $C(7) S %A="THIS CODE SHEET HAS ALREADY BEEN PRINTED.",%A(1)="DO YOU WISH TO RETRANSMIT IT",%B="'YES' to mark for retransmission.",%B(1)="'NO' or '^' to hold in file."
|
|---|
| 25 | S %=2 D ^PRCFYN I %'=1 W !,$C(7),"NO ACTION TAKEN " R X:3 K PRCFA("PODA") Q
|
|---|
| 26 | S DR=".3////N;.4///@",DIE="^PRCF(423," D ^DIE
|
|---|
| 27 | G ^PRCFACX0
|
|---|
| 28 | OUT K B,D,D0,DG,DIC,DIE,DIG,DIH,DIU,DIV,DIW,DLAYGO,DR,K,Q,PRCFCS,S,X,XL1 Q
|
|---|
| 29 | DEL ;KILL THE CODE SHEET AND CROSS REFERENCES
|
|---|
| 30 | S %A="Are you sure you want to delete this Code Sheet",%B="'YES' to delete, 'NO' or '^' to retain, but not transmit.",%=2 D ^PRCFYN I %'=1 S X=" <Code Sheet Retained in File>*" D MSG^PRCFQ S PRCFA("CSHOLD")="" Q
|
|---|
| 31 | D WAIT^PRCFYN S DA=PRCFA("CSDA"),DIK="^PRCF(423," D ^DIK S X=" CODE SHEET DELETED*" D MSG^PRCFQ
|
|---|
| 32 | K K,X,DA,PRCFA("CSNAME"),PRCFA("CSDA"),PRCFCS(0) S PRCFDEL="" G OUT
|
|---|
| 33 | Q
|
|---|
