source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHCS8.m@ 1211

Last change on this file since 1211 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1PRCHCS8 ;WISC/RHD-EDIT DEPOT RECEIVING LOG CODE SHEETS ;12/1/93 09:53
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4EN S PRCHN("PO")=$P($P(^PRC(442,PRCHPO,0),"-",2),U,1),PRCFA("SYS")="LOG",PRCFA("REF")=PRCHN("PO"),PRCHAUTO="" W !," Now creating LOG code sheets ."
5 S DA=$P($G(^PRC(442,PRCHPO,11,PRCHRPT,1)),U,7)
6 I 'DA D ^PRCHCS1 Q:'$D(PRCFA) W "."
7 S:'$D(DA) DA="" I 'DA W !,"No code sheets created !",$C(7) K PRCHPO G Q
81 S PRCH=DA,IOP="" D:'$D(IOF) ^%ZIS W !! D HDR^PRCHCS0
911 I '$D(^PRCF(423,PRCH,300))!('$D(^("CODE",1,0))) D ERR1 G 3
10 S Y=^PRCF(423,PRCH,"CODE",1,0) W !,Y I $L(Y)'=80!($O(^PRCF(423,PRCH,"CODE",1))) D ERR^PRCHCS0 G 3
112 W ! S %A="Do you want to transmit this code sheet",%B="'YES' will mark the code sheets for transmission.",%B(1)="'NO' will give you a chance to edit code sheet."
12 S %B(2)="'^' will delete code sheet." D ^PRCFYN G TRAN:%=1,DEL1:%<0
133 S %A="Do you want to edit this code sheet",%B="'YES' to edit code sheet.",%B(1)="'NO' or '^' for chance to delete code sheet." D ^PRCFYN G DEL:%'=1
144 K PRCHLOG S DIE="^PRCF(423,",DA=PRCH,DR=PRCFA("EDIT") D ^DIE S PRCHLOG=1 D ^PRCFACX1
15 G 1
16TRAN I '$D(DT) D NOW^%DTC S DT=$P(%,".",1)
17 S %DT="AEXF",%DT("A")="TRANSMISSION DATE: ",%DT("B")="TODAY",%DT(0)=DT D ^%DT G:Y<0 3 S PRCHDT=Y
18 D SIG^PRCHCS0 I '$D(PRCHNM) D:$D(PRCHLOG) DEL1 K PRCHPO G Q
19 S DA=PRCH,PRCHBTYP=5 D MRK^PRCHCS
20 W !!,$C(7),"CODE SHEET MARKED FOR TRANSMISSION!"
21Q G Q^PRCHCS0
22ERR1 W !?5,"Code sheet has not been completed and needs to be edited !",$C(7)
23 W !! S %A="Do you want to re-create the code sheet",%B="'YES' will rebuild the code sheet from the P.O. data as it was before",%B(1)="editing. Any other answer will do nothing.",%=1 D ^PRCFYN Q:%'=1
24 D ^PRCHCS1 Q:'$D(PRCFA) I $D(DA),DA S PRCH=DA
25 Q
26DEL S %=1,%A="Delete code sheet for this "_$S(PRCHTYP="R":"Partial",1:"Order"),%B="'YES' or '^' to delete the code sheet.",%B(1)="'NO' to have another chance to transmit." D ^PRCFYN G:%=2 1
27DEL1 ;DELETES ALL CODE SHEETS
28 S DIK="^PRCF(423,",DA=PRCH D ^DIK K DIK S DA="" D SETR^PRCHCS1
29 W !,"CODE SHEET DELETED FOR THIS "_$S(PRCHTYP="R":"PARTIAL",1:"ORDER")_" !",$C(7) K PRCHPO G Q
Note: See TracBrowser for help on using the repository browser.