source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSABRKU1.m@ 1712

PSABRKU1 ;BIR/DB-Upload and Process Prime Vendor Invoice Data ;8/19/99
 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26,41**; 10/24/97
 ;
PSAUPLD(RET,TMP) ;uploads data in VISTA
 D NOW^%DTC
 S X=0
 I $G(TMP(0))="******" S PSAOUT=0 D STRT S RET="OK" Q
 I $G(TMP(0))="KEY" G LOGON
 S X=0,CNT=1 F  S X=$O(^TMP($J,"PSAX12",X)) Q:X'>0  S CNT=$G(CNT)+1
 S X=-1 F  S X=$O(TMP(X)) Q:X=""  S DATA=$G(TMP(X)) I $G(DATA)'="" S DATA=$P(DATA,"^",2,99) S ^TMP($J,"PSAX12",CNT,0)=DATA,CNT=$G(CNT)+1
 ;
 ;
 S RET="OK"
 Q
STRT S (PSABBC,PSACNT,PSAISA,PSALINE,PSASEGD,PSALND)=0 K TMP
 D NOW^%DTC S Y=% X ^DD("DD")
 S ^TMP($J,"PSA UPLOAD",.3,0)="Results  : "
 S ^TMP($J,"PSA UPLOAD",.5,0)="Finished                : "_Y
 D NOW^%DTC S DT=$P(%,".")
 F  S PSALINE=$O(^TMP($J,"PSAX12",PSALINE)) Q:'PSALINE  D  Q:PSABBC&(PSAISA)
 .I $E($G(^TMP($J,"PSAX12",PSALINE,0)),1,3)="ISA" S PSADB=^TMP($J,"PSAX12",PSALINE,0) S PSASEGD=$E(^(0),4,4),PSALND=$E(^(0),106,106),PSAISA=1 Q
 ;
 I PSASEGD=""!(PSALND="") D  G KILL
 .S PSASTAR="",$P(PSASTAR,"*",80)=""
 G:PSASEGD="~"&(PSALND="^") LINE
 ;
 ;Changes the data element and segment delimiters to ^ and ~.
 S (PSACNT,PSALINE)=0 F  S PSALINE=$O(^TMP($J,"PSAX12",PSALINE)) Q:'PSALINE  D  Q:PSAOUT
 .S PSADATA=^TMP($J,"PSAX12",PSALINE,0)
 .I PSALND'="~" S PSADATA=$TR(PSADATA,PSALND,"~")
 .I PSASEGD'="^" S PSADATA=$TR(PSADATA,PSASEGD,"^")
 .S ^TMP($J,"PSAX12",PSALINE,0)=PSADATA
 ;
LINE ;Places each segment on a node to itself.
 K ^TMP($J,"PSAPV")
 S PSAHOLD="",(PSACNT,PSALINE)=0
 F  S PSALINE=$O(^TMP($J,"PSAX12",PSALINE)) Q:'PSALINE  D
 .S PSADATA=^TMP($J,"PSAX12",PSALINE,0),PSADATA=PSAHOLD_PSADATA
 .I PSADATA'["~" S PSAHOLD=PSADATA Q
 .S PSASTOP=0 F  S PSASEG=$P(PSADATA,"~") Q:PSASEG=""  D  Q:PSASTOP
 ..S PSACNT=PSACNT+1,^TMP($J,"PSAPV",PSACNT,0)=PSASEG
 ..S PSADATA=$P(PSADATA,"~",2,99) I PSADATA'["~" S PSASTOP=1,PSAHOLD=PSADATA Q
 ..S PSAHOLD=""
 ;
SPACES ;remove all leading spaces in all data elements
 S (PSACNT,PSALINE)=0 F  S PSALINE=$O(^TMP($J,"PSAPV",PSALINE)) Q:'PSALINE  D
 .S PSASEG=^TMP($J,"PSAPV",PSALINE,0)
 .I $E(PSASEG,1,3)="ISA" S ^TMP($J,"PSAPVS",PSALINE)=^TMP($J,"PSAPV",PSALINE,0) Q
 .S PSACNT=0,PSASEGL=$L(PSASEG)
 .F PSAEX=1:1:PSASEGL S PSAX=$E(PSASEG,PSAEX,PSAEX) S:PSAX="^" PSACNT=PSACNT+1
 .F PSAPC=1:1:(PSACNT+1) S PSADE=$P(PSASEG,"^",PSAPC) D
 ..F  Q:$E(PSADE,1,1)'=" "  S PSADE=$E(PSADE,2,999)
 ..S $P(PSASEG,"^",PSAPC)=PSADE
 .S ^TMP($J,"PSAPVS",PSALINE)=PSASEG
 K ^TMP($J,"PSAPV")
 ;
CHECK ;Looks for X12 errors. If no errors, loads data into ^TMP($J,"PSAPV SET")
 D ^PSABRKU3
 D XTMP^PSABRKU4
 S PSANEXT=$O(^XTMP("PSAPV",0))
 D ^PSABRKU6
 ;
KILL K ^TMP($J,"PSAPVS"),^TMP($J,"PSAPV SET"),^TMP($J,"PSAX12")
 K %,DIR,DIRUT,DWLC,PSABBC,PSACNT,PSACTN1,PSACOMB,PSACS,PSACTRL,PSACTRL2,PSADATA,PSADE,PSADT,PSADUP,PSAENTRY,PSAERR,PSAEX,PSAEXPEC,PSAFND1,PSAGS,PSAHOLD,PSAIEN,PSAIN,PSAINV,PSAINVDT,PSAINVN,PSAISA,PSAISIT,PSAISITN,PSAITCNT,PSAITEM
 K PSALAST,PSALINE,PSALLCS,PSALLOK,PSALND,PSALOC,PSANDC,PSANEW,PSANEXT,PSANTYPE,PSAOK,PSAORD,PSAORDDT,PSAORDN,PSAOSIT,PSAOSITN,PSAOUT,PSAPC
 K PSAS,PSASEG,PSASEGL,PSASEGD,PSASS,PSAST,PSASTA,PSASTAR,PSASTCNT,PSASUB,PSASYN,PSAUOM,PSAUOM1,PSAUOMH,PSAUOMH1,PSAVSN,PSAX,X,X1,X2,XTKDIC,XTKERR,XTKMODE,Y
 S (X,CNT)=0 F  S X=$O(PSAGUI2(X)) Q:X=""  S CNT=$G(CNT)+1
 I $G(CNT)>0 S ^TMP($J,"PSA UPLOAD",1.6,0)="Orders Uploaded         : "_$G(CNT)
 S (X,CNTR)=0 F  S X=$O(PSAGUI3(X)) Q:X=""  S CNTR=$G(CNTR)+1
 I $G(CNTR)>0 S ^TMP($J,"PSA UPLOAD",1.7,0)="Invoices Uploaded       : "_$G(CNTR)
 S ^TMP($J,"PSA UPLOAD",1.8,0)="Line Items Uploaded     : "_$G(PSAGUI4)
 S RET=$G(CNT)_"^"_$G(CNTR)_"^"_$G(PSAGUI4) K CNT,CNTR
 K PSAGUI1
 I $D(^TMP($J,"PSA UPLOAD")) S XMSUB="Upload Status Report",XMDUZ="DRUG ACCOUNTABILITY UPLOAD INTERFACE",XMY(DUZ)="",XMTEXT="^TMP($J,"_"""PSA UPLOAD"""_"," D ^XMD
 K ^TMP($J,"PSA UPLOAD"),^TMP($J,"PSAX12"),^TMP($J,"PSAPVS")
 Q
LOGON ;Check security key
 S (PSAGUI2,PSAGUI3,PSAGUI4)=0
 K ^TMP($J,"PSAX12"),^TMP($J,"PSA UPLOAD"),PSACNT,CNT
 I '$D(^XUSEC("PSA ORDERS",DUZ)) S RET(0)="0" Q
 D NOW^%DTC S Y=% X ^DD("DD") S ^TMP($J,"PSA UPLOAD",.4,0)="Upload Started          : "_Y,RET(0)=1 Q
 Q