| 1 | PRCESOE1 ;WISC/SJG-1358 OBLIGATION UTILITIES ;7/24/00  23:22 | 
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000 | 
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified. | 
|---|
| 4 | ; | 
|---|
| 5 | QUIT | 
|---|
| 6 | ; No top level entry | 
|---|
| 7 | ; | 
|---|
| 8 | LOOKUP ; Lookup 1358 transaction which is pending fiscal action. | 
|---|
| 9 | N DIC,FSO,TN | 
|---|
| 10 | S:'$D(TT) TT="O" | 
|---|
| 11 | S DIC=410,DIC(0)="AEMNZ",FSO=$O(^PRCD(442.3,"AC",10,0)),DIC("S")="S TN=^(0) I $P($P(TN,U),""-"",1,2)=PRCF(""SIFY""),TT[$P(TN,U,2),$P(TN,""^"",4)=1,$D(^(10)),$P(^(10),U,4)=FSO" | 
|---|
| 12 | D ^PRCSDIC | 
|---|
| 13 | QUIT | 
|---|
| 14 | POST ; Post data in file 424 | 
|---|
| 15 | N X,Z,DAR,DIC,Y,DA,DIE,DR,TIME | 
|---|
| 16 | S (X,Z)=PATNUM,%=1 D EN1^PRCSUT3 I +$P(X,"-",3)>1 W $C(7),!,"This is not a new 1358.  Adjustments may only be entered through the",!,"adjustment option." H 3 S %=0 Q | 
|---|
| 17 | S DIC=424,DIC(0)="LX",DLAYGO=424 D ^DIC K DLAYGO I Y<0 W !,"ERROR IN CREATING 424 RECORD" S %=0 Q | 
|---|
| 18 | S DAR=+Y | 
|---|
| 19 | D NOW^%DTC S TIME=%,DIE=DIC,DA=DAR,X=PODA,DR=".02////^S X=PODA;.03////^S X=""O"";.06////^S X=$P(PO(0),U,11);.07////^S X=TIME;.08////^S X=DUZ;1.1///^S X=""INITIAL OBLIGATION"";.15////^S X=OB" | 
|---|
| 20 | D ^DIE S %=1 | 
|---|
| 21 | QUIT | 
|---|
| 22 | ; Message Processing called from PRCESOE | 
|---|
| 23 | MSG ; | 
|---|
| 24 | W !! K MSG S MSG="No further processing is being taken on this obligation." | 
|---|
| 25 | D EN^DDIOL(MSG) K MSG | 
|---|
| 26 | Q | 
|---|
| 27 | MSG1    ; | 
|---|
| 28 | W !! K MSG S MSG(1)="No further processing is being taken on this 1358.  It has NOT been obligated." | 
|---|
| 29 | S MSG(2)="The entry in the Purchase Order file is being deleted." | 
|---|
| 30 | D EN^DDIOL(.MSG) K MSG | 
|---|
| 31 | Q | 
|---|
| 32 | MSG2(MSG) ; | 
|---|
| 33 | S:'$D(ROUTINE) ROUTINE="PRCUESIG" | 
|---|
| 34 | W !!,$$ERROR^PRCFFU13(ROUTINE,MSG) | 
|---|
| 35 | D MSG | 
|---|
| 36 | Q | 
|---|
| 37 | MSG3 ; | 
|---|
| 38 | S MSG(1)="No Obligation Number or Common Number Series has been selected." | 
|---|
| 39 | S MSG(2)="No further action taken on this obligation." | 
|---|
| 40 | W !! D EN^DDIOL(.MSG) H 3 K MSG | 
|---|
| 41 | Q | 
|---|