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