source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHSTAT.m@ 623

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

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1PRCHSTAT ;WISC/TGH-UTILITY PROGRAM FOR UPDATING SUPPLY STATUS ON 442 ;10/30/92 1:58 PM ;10/30/92 1:57 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4ENXS ;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
9ENXK ;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
14ENF ;X=FISCAL STATUS ORDER, DA=INTERNAL RECORD NO. ON 442
15 NEW Y S Y=$O(^PRCD(442.3,"AC",+X,0)) G UPD
16ENS ;X=SUPPLY STATUS ORDER, DA=INTERNAL RECORD NO. ON 442
17 NEW Y S Y=$O(^PRCD(442.3,"C",+X,0)) G UPD
18UPD ;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
21EXIT K PRCHX,Y Q
22ERR K X G EXIT
Note: See TracBrowser for help on using the repository browser.