Routine: PSABRKU1

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"

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")

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSABRKU1   4187     printed  Apr 23, 2025@18:03:19                                                                                                                                                                                                    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

PSABRKU1.m