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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFUOA 778 printed Dec 13, 2024@02:04:28 Page 2
PRCFUOA ;WISC/SJG/PL-850 UNDELIVERED ORDERS RECONCILIATION ; 8/22/96 1:40 PM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
DQ ;
+1 SET (PRCFAT,PRCFCT,PRCFOT,PRCFCS,PRCFOS,PRCFAS)=0
SET L=0
+2 SET DIC="^PRC(442,"
SET FLDS="[PRCFUO]"
SET BY="[PRCFUO]"
+3 SET DIOEND="D B^PRCFUO"
if $DATA(ION)
SET IOP=ION
+4 SET PRCFI=";30;31;33;37;38;40;41;45;48;49;"
SET PRCFMOP=";1;8;"
+5 SET 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)_"";"")"
+6 SET DIS(1)="I $D(^PRC(442,D0,0)),$P(^(0),U,2),PRCFMOP[("";""_$P(^(0),U,2)_"";"") D C^PRCFUO I PRCFU>.01"
+7 DO EN1^DIP
EXIT ;
+1 KILL BY,DIC,DIOEND,DIS,FLDS,L,PRCFAS,PRCFAT,PRCFCS,PRCFCT,PRCFI,PRCFMOP,PRCFOS,PRCFOT
+2 QUIT
