PRCOSSO ;WISC/DJM-SSO Server Interface to IFCAP ;10/3/94  10:45 AM
V ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 Q
SSO ;SUGGESTED ORDER TRANSACTION FROM AUSTIN USED TO CREATE A REPETITIVE ITEM LIST
 N %,A,AA,AQ,A1,B,C,COUNT,CP,CS,CSF,DA,DIC,DIE,DIK,DR,DT,E,F,FS,FY,INACT,LC,L1,MO,NSN,NSNB,NSNC,NSNF,PRCDA,QTR,QTY,QTYL,REC,SC,SITE,TC,TIME,TYP,UC,VEN,VEN1,VENDOR,WF,Y,Y1,YR
 S A=1,A1="" F  S A=$O(^PRC(411,"B",A)) Q:A'>0  S A1=A1_"-"_A
 S:$L(A1)>0 A1=A1_"-" S B=$O(^PRCF(423.6,PRCDA,1,0)),L1=^(B,0),SITE=$P(L1,U,3) I A1'[SITE D MSG1^PRCOSS5(L1) Q
 S B=$O(^PRCF(423.6,PRCDA,1,B)),C=^(B,0) I $P(C,U)'="LC" D MSG2^PRCOSS5(L1) Q
 S COUNT=$P(C,U,2),LC=B I COUNT="" D MSG3^PRCOSS5(L1) Q
 S (QTY,TYP,C,NSNF,CSF)="" F  S B=$O(^PRCF(423.6,PRCDA,1,B)) Q:B=""  S C=^(B,0) S TYP=$P(C,U) Q:TYP'="SL"  S QTY=QTY+1,NSN=$P(C,U,2),CS=$P(C,U,5) S:NSN="" NSNF=1 S:CS="" CSF=1 Q:C="$"
 I TYP'="SL",C'="$" D MSG4^PRCOSS5(L1) Q
 I QTY'=COUNT D MSG5^PRCOSS5(L1) Q
 I NSNF=1 D MSG6^PRCOSS5(L1) Q
 I CSF=1 D MSG8^PRCOSS5(L1) Q
 S B=LC F  S B=$O(^PRCF(423.6,PRCDA,1,B)) Q:B'>0  S C=^(B,0),TYP=$P(C,U) Q:TYP'="SL"  S NSNF="" D  Q:NSNF=1
 .S NSN=$P(C,U,2),NSN=$E(NSN,1,4)_"-"_$E(NSN,5,6)_"-"_$E(NSN,7,9)_"-"_$E(NSN,10,99),NSNB=0
SOA .S NSNB=$O(^PRC(441,"BB",NSN,NSNB)),NSNC="" I NSNB'>0 S NSNF=1 Q
 .S NSNC=^PRC(441,NSNB,0) I $P(NSNC,U,5)'=NSN S NSNF=1 Q
 .S INACT=$G(^PRC(441,NSNB,3)) I +INACT=1 G SOA
 .S CS=$P(C,U,5),VEN=$G(^PRC(441,NSNB,2,0)) I VEN="" S NSNF=1 Q
 .S NSNF=1,VEN=0 F  S VEN=$O(^PRC(441,NSNB,2,VEN)) Q:VEN'>0  S SC="" D  I CS=$P(SC,U) S NSNF="" Q
 ..S VEN1=^PRC(441,NSNB,2,VEN,0) Q:+VEN1'>0  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
 I NSNF=1 S DIE="^PRCF(423.6,",DA=PRCDA,DR="3///65" D ^DIE Q
S1 ;IF THERE WAS NO MISSING NSNs THE SSO^PRCOSSO BACKGROUND TASK WILL FALL THROUGH INTO THIS SECTION OF CODE.
 ;NOW TO CHECK FILE 445, THE WAREHOUSE ENTRY, TO SEE IF ALL ITEMS ARE LISTED IN THE INVENTORY.
 S A="" F  S A=$O(^PRCP(445,"AC","W",A)) Q:A=""  S B=+^PRCP(445,A,0),C=^PRCF(423.6,PRCDA,1,10000,0),CS=$P(C,U,3) I B=CS D  Q
 .S Y=0 F  S Y=$O(^PRCF(423.6,PRCDA,1,Y)) Q:Y'>0  S Y1=^(Y,0) I $P(Y1,U)="SL" S (NSNF,WF)="" D  Q:NSNF=1  Q:WF=1
 ..S NSN=$P(Y1,U,2),NSN=$E(NSN,1,4)_"-"_$E(NSN,5,6)_"-"_$E(NSN,7,9)_"-"_$E(NSN,10,99),NSNB=$O(^PRC(441,"BB",NSN,0)) S:NSNB'>0 NSNF=1 Q:NSNF=1  S:+$G(^PRCP(445,A,1,NSNB,0))'=NSNB WF=1 Q
 I A="" D MSG7^PRCOSS5(C) Q
 I NSNF=1 S DIE="^PRCF(423.6,",DA=PRCDA,DR="3///65" D ^DIE Q
 I WF=1 S DIE="^PRCF(423.6,",DA=PRCDA,DR="4///65" D ^DIE Q
 G S2^PRCOSS6
SSO1 ;ENTER HERE IF THERE WERE MISSING NSNs.  THIS ENTRY POINT IS THE ONE
 ;CALLED FROM THE BACKGROUND JOB SET UP AT THE END OF ENTERING THE MISSING
 ;NSNs.  THE ONLY THING THIS ENTRY POINT DOES IS TO NEW THE VARIABLES USED
 ;WITHIN THE S1 SECTION OF THIS ROUTINE.  THE SAME VARIABLE NAMES ARE USED
 ;IN THE S1 SECTION AS WERE USED IN SSO SO THAT THE NEW COMMAND FOR THAT
 ;SECTION CAN HANDLE THEM IF THE SSO SECTION FALLS THROUGH INTO THE S1
 ;SECTION.
 N A,B,C,CS,DA,DIE,DR,NSN,NSNB,NSNF,WF,Y,Y1 G S1