PRCHSTAT ;WISC/TGH-UTILITY PROGRAM FOR UPDATING SUPPLY STATUS ON 442 ;10/30/92  1:58 PM ;10/30/92  1:57 PM
V ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
ENXS ;SET LOGIC-MUMPS CROSS-REFERENCE ON SUPPLY STATUS (FIELD .5) FILE 442
 Q:'$D(^PRCD(442.3,+X,0))  S PRCHZ1=$P(^(0),U,2),PRCHZ2=$P(^(0),U,3)
 I PRCHZ1 S $P(^PRC(442,DA,7),U,2)=PRCHZ1,^PRC(442,"AH",PRCHZ1,DA)=""
 I PRCHZ2 S $P(^PRC(442,DA,7),U,4)=PRCHZ2,^PRC(442,"AI",PRCHZ2,DA)=""
 K PRCHZ1,PRCHZ2 Q
ENXK ;KILL LOGIC-MUMPS CROSS-REFERENCE ON SUPPLY STATUS (FIELD .5) FILE 442
 Q:'$D(^PRCD(442.3,+X,0))  S PRCHZ1=$P(^(0),U,2),PRCHZ2=$P(^(0),U,3)
 I PRCHZ1 S $P(^PRC(442,DA,7),U,2)="" K ^PRC(442,"AH",PRCHZ1,DA)
 I PRCHZ2 S $P(^PRC(442,DA,7),U,4)="" K ^PRC(442,"AI",PRCHZ2,DA)
 K PRCHZ1,PRCHZ2 Q
ENF ;X=FISCAL STATUS ORDER, DA=INTERNAL RECORD NO. ON 442
 NEW Y S Y=$O(^PRCD(442.3,"AC",+X,0)) G UPD
ENS ;X=SUPPLY STATUS ORDER, DA=INTERNAL RECORD NO. ON 442
 NEW Y S Y=$O(^PRCD(442.3,"C",+X,0)) G UPD
UPD ;UPDATE SUPPLY STATUS, SUPPLY STATUS ORDER & FISCAL STATUS ORDER ON FILE 442
 G:'Y ERR G:'$D(^PRCD(442.3,Y,0)) ERR
 NEW DIE,DR,PRCHX S PRCHX=X,X=Y,DIE="^PRC(442,",DR=".5////"_Y D ^DIE K DIE,DR S X=PRCHX
EXIT K PRCHX,Y Q
ERR K X G EXIT