15 lines
764 B
Mathematica
15 lines
764 B
Mathematica
PRCFUOA ;WISC/SJG/PL-850 UNDELIVERED ORDERS RECONCILIATION ; 8/22/96 1:40 PM
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
DQ ;
|
|
S (PRCFAT,PRCFCT,PRCFOT,PRCFCS,PRCFOS,PRCFAS)=0,L=0
|
|
S DIC="^PRC(442,",FLDS="[PRCFUO]",BY="[PRCFUO]"
|
|
S DIOEND="D B^PRCFUO" S:$D(ION) IOP=ION
|
|
S PRCFI=";30;31;33;37;38;40;41;45;48;49;",PRCFMOP=";1;8;"
|
|
S DIS(0)="I $D(^PRC(442,D0,0)),$O(^PRC(442,D0,22,0))>0 I $P(^PRC(442,D0,0),U,17)'=$P(^(0),U,16) I $G(^PRC(442,D0,7)),PRCFI'[("";""_$P($G(^PRC(442,D0,7)),""^"",2)_"";"")"
|
|
S DIS(1)="I $D(^PRC(442,D0,0)),$P(^(0),U,2),PRCFMOP[("";""_$P(^(0),U,2)_"";"") D C^PRCFUO I PRCFU>.01"
|
|
D EN1^DIP
|
|
EXIT ;
|
|
KILL BY,DIC,DIOEND,DIS,FLDS,L,PRCFAS,PRCFAT,PRCFCS,PRCFCT,PRCFI,PRCFMOP,PRCFOS,PRCFOT
|
|
Q
|