| [613] | 1 | PRCOSS1 ;WISC/DJM-SSO Server Interface to IFCAP ;8/20/93 14:42
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | EN1 ;CALLED FROM PRCHUSER PPM OPTION MENU ENTRY ACTION.
|
|---|
| 6 | ;NOTIFY PPM THAT NEW ENTRIES NEED TO BE ADDED INTO FILE 441.
|
|---|
| 7 | I $O(^PRCF(423.6,"AC",0))>0 W $C(7),!!!,?3,"There are new ITEM MASTER entries from ISMS SSO transaction to be added." Q
|
|---|
| 8 | Q
|
|---|
| 9 | DISP ;CALLED FROM EN1^PRCHE.
|
|---|
| 10 | ;DISPLAY ALL "SL" SEGMENTS THAT:
|
|---|
| 11 | ; 1. ARE FOR THE USER'S SITE.
|
|---|
| 12 | ; 2. THE NSN IS NOT FOUND IN FILE 441.
|
|---|
| 13 | N CS,FS,HDR,INACT,INACTF,NSN,NSNB,NSNC,NSND,NSNF,SC,VEN,VENF,VEN1,X,X1,X2,Y,Y1
|
|---|
| 14 | S HDR="",X=0 F S X=$O(^PRCF(423.6,"AC",65,X)) Q:X'>0 S X1=^PRCF(423.6,X,1,10000,0) I $P(X1,U,3)=PRC("SITE") D
|
|---|
| 15 | .S Y=0 F S Y=$O(^PRCF(423.6,X,1,Y)) Q:Y'>0 S Y1=^(Y,0) I $P(Y1,U)="SL" S (NSNF,INACTF,VENF)="" D
|
|---|
| 16 | ..S NSN=$P(Y1,U,2),NSN=$E(NSN,1,4)_"-"_$E(NSN,5,6)_"-"_$E(NSN,7,9)_"-"_$E(NSN,10,99),NSNB=0
|
|---|
| 17 | D0 ..S NSNB=$O(^PRC(441,"BB",NSN,NSNB)),NSNC="" I NSNB'>0 S NSNF=1 G D1
|
|---|
| 18 | ..S NSNC=^PRC(441,NSNB,0),NSND=NSNB I $P(NSNC,U,5)'=NSN S NSNF=1 G D1
|
|---|
| 19 | ..S INACT=$G(^PRC(441,NSNB,3)) I +INACT=1 S INACTF=1 G D0
|
|---|
| 20 | ..S CS=$P(Y1,U,5),VEN=$G(^PRC(441,NSNB,2,0)) I VEN="" S VENF=1 G D1
|
|---|
| 21 | ..S VENF=1,VEN=0 F S VEN=$O(^PRC(441,NSNB,2,VEN)) G:VEN'>0 D1 S SC="" D I CS=$P(SC,U) S VENF="" G D1
|
|---|
| 22 | ...S VEN1=^PRC(441,NSNB,2,VEN,0) Q:VEN1="" S FS=$G(^PRC(440,+VEN1,2)) Q:FS="" S FS=$P(FS,U,2) Q:FS="" S SC=$G(^PRCD(420.8,FS,0)) Q
|
|---|
| 23 | D1 ..I NSNF!INACTF!VENF D:HDR="" W !,NSN,?23,$P(Y1,U,3),?32,$P(Y1,U,5) W:INACTF ?42,"YES" W:INACTF!VENF ?52,NSND W:VENF ?65,"NO" Q
|
|---|
| 24 | ...S X2="New items from SSO transactions to add" W ?(IOM-$L(X2))\2-10,X2,!!,?6,"NSN",?23,"SKU",?31,"SOURCE",?40,"INACTIVE",?52,"NUMBER",?62,"SOURCE OK" S HDR=1 Q
|
|---|
| 25 | W ! Q
|
|---|
| 26 | CHECK ;CALLED FROM EN1^PRCHE.
|
|---|
| 27 | ;CHECK ALL RECORDS THAT:
|
|---|
| 28 | ; 1. ARE FOR THE USER'S SITE.
|
|---|
| 29 | ; 2. ALL NSN IN THE "SSO" TRANSACTION EXIST IN FILE 441.
|
|---|
| 30 | ; 3. IF NSN FOUND, CHECK THAT ITEM MASTER ENTRY IS ACTIVE.
|
|---|
| 31 | ; 4. IF ITEM MASTER ENTRY IS CORRECT, CHECK THAT SOURCE CODE EQUALS
|
|---|
| 32 | ; THE SUGGESTED SOURCE IN "SSO" TRANSACTION.
|
|---|
| 33 | ;
|
|---|
| 34 | ;IF THE RECORD PASSES THE CHECKS, START UP A NEW BACKGROUND TASK TO
|
|---|
| 35 | ;CHECK FOR FILE 445 ENTRIES.
|
|---|
| 36 | ;
|
|---|
| 37 | N CS,DA,DIE,DR,INACT,NSN,NSNB,NSNC,NSNF,PRCDA,SC,VEN,VENF,VEN1,X,X1,Y,Y1,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
|
|---|
| 38 | S X=0 F S X=$O(^PRCF(423.6,"AC",65,X)) Q:X'>0 S X1=^PRCF(423.6,X,1,10000,0) I $P(X1,U,3)=PRC("SITE") S NSNF="" D
|
|---|
| 39 | .S Y=0 F S Y=$O(^PRCF(423.6,X,1,Y)) Q:Y'>0 S Y1=^(Y,0) I $P(Y1,U)="SL" D Q:NSNF=1
|
|---|
| 40 | ..S NSN=$P(Y1,U,2),NSN=$E(NSN,1,4)_"-"_$E(NSN,5,6)_"-"_$E(NSN,7,9)_"-"_$E(NSN,10,99),NSNB=0
|
|---|
| 41 | CK1 ..S NSNB=$O(^PRC(441,"BB",NSN,NSNB)),NSNC="" I NSNB'>0 S NSNF=1 Q
|
|---|
| 42 | ..S NSNC=^PRC(441,NSNB,0) I $P(NSNC,U,5)'=NSN S NSNF=1 Q
|
|---|
| 43 | ..S INACT=$G(^PRC(441,NSNB,3)) I +INACT=1 G CK1
|
|---|
| 44 | ..S CS=$P(Y1,U,5),VEN=$G(^PRC(441,NSNB,2,0)) I VEN="" S NSNF=1 Q
|
|---|
| 45 | ..S VENF=1,VEN=0 F S VEN=$O(^PRC(441,NSNB,2,VEN)) Q:VEN'>0 S SC="" D I CS=$P(SC,U) S VENF="" Q
|
|---|
| 46 | ...S VEN1=^PRC(441,NSNB,2,VEN,0) Q:VEN1="" S FS=$G(^PRC(440,+VEN1,2)) Q:FS="" S FS=$P(FS,U,2) Q:FS'>0 S SC=$G(^PRCD(420.8,FS,0)) Q
|
|---|
| 47 | ..S:VENF NSNF=1 Q
|
|---|
| 48 | .I NSNF="",X>0 S PRCDA=X,ZTSAVE("PRCDA")="",ZTSAVE("ZTREQ")="@",ZTRTN="SSO1^PRCOSSO",ZTDTH=$H,ZTIO="" D ^%ZTLOAD L +^PRCF(423.6,PRCDA,0) S DIE="^PRCF(423.6,",DA=PRCDA,DR="3///@;2///^S X=ZTSK" D ^DIE L -^PRCF(423.6,PRCDA,0)
|
|---|
| 49 | .Q
|
|---|
| 50 | Q
|
|---|
