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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSABRKU1 4187 printed Apr 09, 2024@20:54:50 Page 2
PSABRKU1 ;BIR/DB-Upload and Process Prime Vendor Invoice Data ;8/19/99
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26,41**; 10/24/97
+2 ;
PSAUPLD(RET,TMP) ;uploads data in VISTA
+1 DO NOW^%DTC
+2 SET X=0
+3 IF $GET(TMP(0))="******"
SET PSAOUT=0
DO STRT
SET RET="OK"
QUIT
+4 IF $GET(TMP(0))="KEY"
GOTO LOGON
+5 SET X=0
SET CNT=1
FOR
SET X=$ORDER(^TMP($JOB,"PSAX12",X))
if X'>0
QUIT
SET CNT=$GET(CNT)+1
+6 SET X=-1
FOR
SET X=$ORDER(TMP(X))
if X=""
QUIT
SET DATA=$GET(TMP(X))
IF $GET(DATA)'=""
SET DATA=$PIECE(DATA,"^",2,99)
SET ^TMP($JOB,"PSAX12",CNT,0)=DATA
SET CNT=$GET(CNT)+1
+7 ;
+8 ;
+9 SET RET="OK"
+10 QUIT
STRT SET (PSABBC,PSACNT,PSAISA,PSALINE,PSASEGD,PSALND)=0
KILL TMP
+1 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+2 SET ^TMP($JOB,"PSA UPLOAD",.3,0)="Results : "
+3 SET ^TMP($JOB,"PSA UPLOAD",.5,0)="Finished : "_Y
+4 DO NOW^%DTC
SET DT=$PIECE(%,".")
+5 FOR
SET PSALINE=$ORDER(^TMP($JOB,"PSAX12",PSALINE))
if 'PSALINE
QUIT
Begin DoDot:1
+6 IF $EXTRACT($GET(^TMP($JOB,"PSAX12",PSALINE,0)),1,3)="ISA"
SET PSADB=^TMP($JOB,"PSAX12",PSALINE,0)
SET PSASEGD=$EXTRACT(^(0),4,4)
SET PSALND=$EXTRACT(^(0),106,106)
SET PSAISA=1
QUIT
End DoDot:1
if PSABBC&(PSAISA)
QUIT
+7 ;
+8 IF PSASEGD=""!(PSALND="")
Begin DoDot:1
+9 SET PSASTAR=""
SET $PIECE(PSASTAR,"*",80)=""
End DoDot:1
GOTO KILL
+10 if PSASEGD="~"&(PSALND="^")
GOTO LINE
+11 ;
+12 ;Changes the data element and segment delimiters to ^ and ~.
+13 SET (PSACNT,PSALINE)=0
FOR
SET PSALINE=$ORDER(^TMP($JOB,"PSAX12",PSALINE))
if 'PSALINE
QUIT
Begin DoDot:1
+14 SET PSADATA=^TMP($JOB,"PSAX12",PSALINE,0)
+15 IF PSALND'="~"
SET PSADATA=$TRANSLATE(PSADATA,PSALND,"~")
+16 IF PSASEGD'="^"
SET PSADATA=$TRANSLATE(PSADATA,PSASEGD,"^")
+17 SET ^TMP($JOB,"PSAX12",PSALINE,0)=PSADATA
End DoDot:1
if PSAOUT
QUIT
+18 ;
LINE ;Places each segment on a node to itself.
+1 KILL ^TMP($JOB,"PSAPV")
+2 SET PSAHOLD=""
SET (PSACNT,PSALINE)=0
+3 FOR
SET PSALINE=$ORDER(^TMP($JOB,"PSAX12",PSALINE))
if 'PSALINE
QUIT
Begin DoDot:1
+4 SET PSADATA=^TMP($JOB,"PSAX12",PSALINE,0)
SET PSADATA=PSAHOLD_PSADATA
+5 IF PSADATA'["~"
SET PSAHOLD=PSADATA
QUIT
+6 SET PSASTOP=0
FOR
SET PSASEG=$PIECE(PSADATA,"~")
if PSASEG=""
QUIT
Begin DoDot:2
+7 SET PSACNT=PSACNT+1
SET ^TMP($JOB,"PSAPV",PSACNT,0)=PSASEG
+8 SET PSADATA=$PIECE(PSADATA,"~",2,99)
IF PSADATA'["~"
SET PSASTOP=1
SET PSAHOLD=PSADATA
QUIT
+9 SET PSAHOLD=""
End DoDot:2
if PSASTOP
QUIT
End DoDot:1
+10 ;
SPACES ;remove all leading spaces in all data elements
+1 SET (PSACNT,PSALINE)=0
FOR
SET PSALINE=$ORDER(^TMP($JOB,"PSAPV",PSALINE))
if 'PSALINE
QUIT
Begin DoDot:1
+2 SET PSASEG=^TMP($JOB,"PSAPV",PSALINE,0)
+3 IF $EXTRACT(PSASEG,1,3)="ISA"
SET ^TMP($JOB,"PSAPVS",PSALINE)=^TMP($JOB,"PSAPV",PSALINE,0)
QUIT
+4 SET PSACNT=0
SET PSASEGL=$LENGTH(PSASEG)
+5 FOR PSAEX=1:1:PSASEGL
SET PSAX=$EXTRACT(PSASEG,PSAEX,PSAEX)
if PSAX="^"
SET PSACNT=PSACNT+1
+6 FOR PSAPC=1:1:(PSACNT+1)
SET PSADE=$PIECE(PSASEG,"^",PSAPC)
Begin DoDot:2
+7 FOR
if $EXTRACT(PSADE,1,1)'=" "
QUIT
SET PSADE=$EXTRACT(PSADE,2,999)
+8 SET $PIECE(PSASEG,"^",PSAPC)=PSADE
End DoDot:2
+9 SET ^TMP($JOB,"PSAPVS",PSALINE)=PSASEG
End DoDot:1
+10 KILL ^TMP($JOB,"PSAPV")
+11 ;
CHECK ;Looks for X12 errors. If no errors, loads data into ^TMP($J,"PSAPV SET")
+1 DO ^PSABRKU3
+2 DO XTMP^PSABRKU4
+3 SET PSANEXT=$ORDER(^XTMP("PSAPV",0))
+4 DO ^PSABRKU6
+5 ;
KILL KILL ^TMP($JOB,"PSAPVS"),^TMP($JOB,"PSAPV SET"),^TMP($JOB,"PSAX12")
+1 KILL %,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
+2 KILL PSALAST,PSALINE,PSALLCS,PSALLOK,PSALND,PSALOC,PSANDC,PSANEW,PSANEXT,PSANTYPE,PSAOK,PSAORD,PSAORDDT,PSAORDN,PSAOSIT,PSAOSITN,PSAOUT,PSAPC
+3 KILL PSAS,PSASEG,PSASEGL,PSASEGD,PSASS,PSAST,PSASTA,PSASTAR,PSASTCNT,PSASUB,PSASYN,PSAUOM,PSAUOM1,PSAUOMH,PSAUOMH1,PSAVSN,PSAX,X,X1,X2,XTKDIC,XTKERR,XTKMODE,Y
+4 SET (X,CNT)=0
FOR
SET X=$ORDER(PSAGUI2(X))
if X=""
QUIT
SET CNT=$GET(CNT)+1
+5 IF $GET(CNT)>0
SET ^TMP($JOB,"PSA UPLOAD",1.6,0)="Orders Uploaded : "_$GET(CNT)
+6 SET (X,CNTR)=0
FOR
SET X=$ORDER(PSAGUI3(X))
if X=""
QUIT
SET CNTR=$GET(CNTR)+1
+7 IF $GET(CNTR)>0
SET ^TMP($JOB,"PSA UPLOAD",1.7,0)="Invoices Uploaded : "_$GET(CNTR)
+8 SET ^TMP($JOB,"PSA UPLOAD",1.8,0)="Line Items Uploaded : "_$GET(PSAGUI4)
+9 SET RET=$GET(CNT)_"^"_$GET(CNTR)_"^"_$GET(PSAGUI4)
KILL CNT,CNTR
+10 KILL PSAGUI1
+11 IF $DATA(^TMP($JOB,"PSA UPLOAD"))
SET XMSUB="Upload Status Report"
SET XMDUZ="DRUG ACCOUNTABILITY UPLOAD INTERFACE"
SET XMY(DUZ)=""
SET XMTEXT="^TMP($J,"_"""PSA UPLOAD"""_","
DO ^XMD
+12 KILL ^TMP($JOB,"PSA UPLOAD"),^TMP($JOB,"PSAX12"),^TMP($JOB,"PSAPVS")
+13 QUIT
LOGON ;Check security key
+1 SET (PSAGUI2,PSAGUI3,PSAGUI4)=0
+2 KILL ^TMP($JOB,"PSAX12"),^TMP($JOB,"PSA UPLOAD"),PSACNT,CNT
+3 IF '$DATA(^XUSEC("PSA ORDERS",DUZ))
SET RET(0)="0"
QUIT
+4 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET ^TMP($JOB,"PSA UPLOAD",.4,0)="Upload Started : "_Y
SET RET(0)=1
QUIT
+5 QUIT
