source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHDEL.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 986 bytes
Line 
1PRCHDEL ;WISC/AKS-CHECKING OLDER AMENDMENTS ;
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 N PO,AM,X,EXPO,EXPO1,AUTODEL,N,PRCTMP
5 S PO=0 F S PO=$O(^PRC(443.6,PO)) Q:'PO D
6 .S AM=0 F S AM=$O(^PRC(443.6,PO,6,AM)) Q:'AM I $D(^PRC(443.6,PO,6,AM,0)) D
7 ..;X variable created with NOW^%DTC must be available for DW^%DTC.
8 ..D NOW^%DTC I X'<$P($P(^PRC(443.6,PO,6,AM,0),U,12),".") D
9 ...I $P($G(^PRC(443.6,PO,6,AM,1)),U,2)]"" D Q
10 ....I $G(X)>0 D DW^%DTC I X="SATURDAY"!(X="SUNDAY") Q
11 ....N SUBINFO S SUBINFO="443.67^15^"_AM
12 ....D GENDIQ^PRCFFU7(443.6,+PO,50,"IEN",SUBINFO)
13 ....S AUTODEL=$G(PRCTMP(443.67,+AM,15,"E"))
14 ....D BULLET^PRCHAMBL(+PO,+AM,AUTODEL)
15 ...S EXPO=$P(^PRC(443.6,PO,0),U),EXPO1=$P(EXPO,"-",2)
16 ...S N=0 F S N=$O(^PRC(441.7,"B",EXPO,N)) Q:N'>0 D
17 ....S DA=N,DIE=441.7,DR=".01///@" D ^DIE K DA,DIE,DR
18 ...K ^PRC(443.6,"B",EXPO),^PRC(443.6,"C",PO),^PRC(443.6,"D",PO)
19 ...K ^PRC(443.6,"E",EXPO1),^PRC(443.6,PO)
20 QUIT
Note: See TracBrowser for help on using the repository browser.