PSAVER3 ;BIR/JMB-Verify Invoices - CONT'D ;9/5/97
;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,19,21,64,70,82**;10/24/97;Build 4
;This routine checks for verification errors, prints an error report,
;& changes data in DA ORDERS to verification if there are no errors.
;
;References to ^DIC(51.5 are covered by IA #1931
;References to ^PSDRUG( are covered by IA #2095
;
SETLINE ;Set line as verified if all data is present.
K PSADRG,PSAOU,PSAQTY S (PSADJN,PSADJ)=0
S PSADATA=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0))
I $O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,0)) D
.S PSAA=$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,0)) Q:PSAA=2
.S PSADJ=0 F S PSADJ=$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ)) Q:'PSADJ D
..Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
..S PSADJN=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)
..I $P(PSADJN,"^")="D" D
...I (+$P(PSADJN,"^",9)&($P(PSADJN,"^",6)'?.N))!('+$P(PSADJN,"^",9)&(+$P(PSADJN,"^",5))&($P(PSADJN,"^",2)'?.N)) S PSASUP=PSASUP+1,PSALNSU=1,PSADRG=0 Q
...S PSADRG=$S($P(PSADJN,"^",6)'="":$P(PSADJN,"^",6),$P(PSADJN,"^",2)'="":$P(PSADJN,"^",2),1:0)
..I $P(PSADJN,"^")="O" S PSAOU=$S(+$P(PSADJN,"^",6):+$P(PSADJN,"^",6),+$P(PSADJN,"^",2):+$P(PSADJN,"^",2),1:0)
..I $P(PSADJN,"^")="Q" S PSAQTY=$S($P(PSADJN,"^",6)'="":+$P(PSADJN,"^",6),$P(PSADJN,"^",2)'="":+$P(PSADJN,"^",2),1:0)
S:'$G(PSADRG) PSADRG=+$P(PSADATA,"^",2) S:'$D(PSAQTY) PSAQTY=+$P(PSADATA,"^",3)
;DAVE B (13SEP99) PSA*3*19 If item is supply, skip this area
I $G(PSALNSU)=1,$G(PSADRG)=0,$G(PSASUP)>0 G SUPPLY
S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)),PSANDC=$P(PSADATA,"^",11)
;DAVE B (PSA*3*19) Check for exisitence of NDC
S PSASUB=$S(+$P(PSATEMP,"^",3):+$P(PSATEMP,"^",3),1:0) ;NDC may be zero
I $G(PSANDC)'="",$G(PSANDC)'=0,$G(PSADRG)'="",$G(PSADRG)'=0,$D(^PSDRUG("C",PSANDC,PSADRG)) S PSASUB=$S($G(PSASUB):$G(PSASUB),+$O(^PSDRUG("C",PSANDC,PSADRG,0)):+$O(^PSDRUG("C",PSANDC,PSADRG,0)),1:0)
S PSADUOU=+$P(PSATEMP,"^"),PSAREORD=+$P(PSATEMP,"^",2),PSASTOCK=+$P(PSATEMP,"^",4)
I '$D(PSAOU) D
.I +$P(PSADATA,"^",4),$P($G(^DIC(51.5,+$P(PSADATA,"^",4),0)),"^")'="" S PSAOU=+$P(PSADATA,"^",4) Q
.I PSADRG,PSASUB,$P($G(^PSDRUG(PSADRG,1,PSASUB,0)),"^",5) S PSAOU=$P($G(^PSDRUG(PSADRG,1,PSASUB,0)),"^",5) Q
.I $P(PSATEMP,"^",5)'="",+$P($P(PSATEMP,"^",5),"~",2) S PSAOU=+$P($P(PSATEMP,"^",5),"~",2)
I PSASUB D
.;Next line added 8APR98 (Dave B)
.S PSALOC=$S($G(PSALOC)'="":PSALOC,1:$S($P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",12):$P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",12),$P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",5):$P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",5),1:0))
.S:'PSADUOU PSADUOU=$S(PSADRG&(+$P($G(^PSDRUG(PSADRG,1,PSASUB,0)),"^",7)):+$P($G(^PSDRUG(PSADRG,1,PSASUB,0)),"^",7),1:1)
.S:'PSASTOCK PSASTOCK=$S(PSADRG:+$P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",3),1:0)
.S:'PSAREORD PSAREORD=$S(PSADRG:+$P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",5),1:0)
;
SUPPLY ;If it is a supply, automatically verify it.
I '+$G(PSAERR),PSALNSU,'$G(PSAPRINT) D VERIFY,VERIFY1 Q
Q:$G(PSASUP)&(+$G(PSAERR)) ;; <PSA*3*70 RJS
;
NEWDRUG ;Store in array if drug is new to location/vault
I +PSADRG D
.I $P($G(^PSDRUG(PSADRG,2)),"^",3)["N",+$P(PSAIN,"^",12),'$D(^PSD(58.8,+$P(PSAIN,"^",12),1,PSADRG,0)) D
..S PSAHOLD(+$P(PSAIN,"^",12),PSAIEN,PSAIEN1,$S($P($G(^PSDRUG(PSADRG,0)),"^")'="":$P($G(^PSDRUG(PSADRG,0)),"^"),1:"UNKNOWN"))=PSADRG,$P(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),"^",10)=1
.I $P($G(^PSDRUG(PSADRG,2)),"^",3)'["N",+$P(PSAIN,"^",5),'$D(^PSD(58.8,+$P(PSAIN,"^",5),1,PSADRG,0)) D
..S PSAHOLD(+$P(PSAIN,"^",5),PSAIEN,PSAIEN1,$S($P($G(^PSDRUG(PSADRG,0)),"^")'="":$P($G(^PSDRUG(PSADRG,0)),"^"),1:"UNKNOWN"))=PSADRG,$P(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),"^",10)=0
;
NOTSUP ;If it is not a supply, look for drug, qty, dispense units, dispense
;units/order unit, order unit, location/master vault, & reorder level
I '+$P(PSADATA,"^",2)&('$G(PSADRG)) S PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$G(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_"D"
I $P(PSADATA,"^",3)=""&($G(PSAQTY)="") S PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$G(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_"Q"
I $P($G(^PSDRUG(PSADRG,660)),"^",8)="" S PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$G(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_8
I '+$P($G(^PSDRUG(PSADRG,1,+PSASUB,0)),"^",7)&('+$G(PSADUOU)) S PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$G(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_"U"
I '+$P(PSADATA,"^",4)&('$G(PSAOU)) S PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$G(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_"O"
;
I $P($G(^PSDRUG(PSADRG,2)),"^",3)'["N" D
.I '+$P(PSAIN,"^",5) S PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$G(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_"P" D CS^PSAVER5
.S $P(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),"^",10)=0,PSADATA=^(0)
I $P(PSAIN,"^",8)="N"!($P(PSAIN,"^",8)="S"),'+$P(PSAIN,"^",5),$G(PSANOVER(PSAIEN,PSAIEN1,PSALINE))'["P" S PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$G(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_"P"
;
I $P($G(^PSDRUG(PSADRG,2)),"^",3)["N" D
.I '+$P(PSAIN,"^",12) S PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$G(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_"M" D CS^PSAVER5
.S $P(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),"^",10)=1,PSADATA=^(0)
I $P(PSAIN,"^",8)="A"!($P(PSAIN,"^",8)="S"),'+$P(PSAIN,"^",12),$G(PSANOVER(PSAIEN,PSAIEN1,PSALINE))'["M" S PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$G(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_"M"
;
S:$D(PSANOVER(PSAIEN,PSAIEN1,PSALINE)) PSAERR=PSAERR+1,PSALNERR=1
I 'PSAERR D GOOD Q
Q
;
GOOD ;If no errors found, verify invoice.
D VERIFY,VERIFY1
S PSAL=0 F S PSAL=+$O(PSAHOLD(PSAL)) Q:'PSAL D
.S PSANAME="" F S PSANAME=$O(PSAHOLD(PSAL,PSAIEN,PSAIEN1,PSANAME)) Q:PSANAME="" D
..S PSANEWD(PSAL,PSANAME)=PSAHOLD(PSAL,PSAIEN,PSAIEN1,PSANAME)
K PSAHOLD
Q
;
PRINT ;Prints verification error list
S DIR(0)="Y",DIR("A")="Do you want to print the verification error report",DIR("B")="N"
S DIR("?",1)="Enter YES if you want to print the report just displayed.",DIR("?")="Enter NO if you do not want to print the report.",DIR("??")="^D PRINTYN^PSAVER3"
D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
Q:Y=""!('+Y)
W ! S %ZIS="Q" D ^%ZIS Q:POP
I $D(IO("Q")) D Q
.S ZTDESC="Drug Acct. - Print Prime Vendor Invoices",ZTRTN="PRN^PSAVER3"
.I $O(PSANOVER(0))'="" S ZTSAVE("PSANOVER(")=""
.F PSASAVE="PSAIN","PSASLN" S:$D(@PSASAVE) ZTSAVE(PSASAVE)=""
.D ^%ZTLOAD
PRN ;Entry point to print verification errors
S (PSAERR,PSALINE,PSAOUT,PSAPG)=0,PSAPRINT=1
S PSAIEN=0 F S PSAIEN=$O(PSANOVER(PSAIEN)) Q:'PSAIEN!(PSAOUT) D
.Q:'$D(^PSD(58.811,PSAIEN,0)) S PSAORD=$P(^PSD(58.811,PSAIEN,0),"^")
.S PSAIEN1=0 F S PSAIEN1=$O(PSANOVER(PSAIEN,PSAIEN1)) Q:'PSAIEN1!(PSAOUT) D
..Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,0)) S PSAIN=^PSD(58.811,PSAIEN,1,PSAIEN1,0),PSAINV=$P(PSAIN,"^")
..S PSALINE=0 F S PSALINE=$O(PSANOVER(PSAIEN,PSAIEN1,PSALINE)) Q:'PSALINE!(PSAOUT) D
...D NOVER
.K PSANOVER(PSAIEN)
W !!,"** The invoice has not been placed in a Verified status!",!
D:$E(IOST,1,2)="C-" END^PSAPROC W:$E(IOST)'="C" @IOF
D ^%ZISC
Q
;
NOVER ;Prints errors
S PSANO=PSANOVER(PSAIEN,PSAIEN1,PSALINE),PSALEN=$L(PSANO)
S PSALINEN=$P($G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)),"^"),PSATAB=$L(PSALINEN)+8
I $E(IOST,1,2)="C-" D:'PSAPG HDR I $Y+(4+PSALEN)>IOSL D END^PSAPROC Q:PSAOUT D HDR
I $E(IOST)'="C",$Y+(4+PSALEN)>IOSL!('PSAPG) D HDR
W "Line# "_PSALINEN_": "
W:PSANO[8 ?PSATAB,"Dispense unit",!
W:PSANO["U" ?PSATAB,"Dispense unit per order unit",!
W:PSANO["D" ?PSATAB,"Drug",!
I PSANO["M" W ?PSATAB,"Master Vault",!
W:PSANO["O" ?PSATAB,"Order unit",!
I PSANO["P" W ?PSATAB,"Pharmacy location",!
W:PSANO["Q" ?PSATAB,"Quantity",!
W !
Q
;
HDR ;Prints header
I $E(IOST,1,2)="C-" W @IOF,!?23,"<<< VERIFICATION ERROR REPORT >>>"
I $E(IOST)'="C" W:PSAPG'=1 @IOF W !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",!?27,"VERIFICATION ERROR REPORT",?72,"Page "_PSAPG,!
S PSAPG=PSAPG+1
W !,"Order#: "_PSAORD_" Invoice#: "_$P(PSAIN,"^")_" Invoice Date: "_$$FMTE^XLFDT(+$P(PSAIN,"^",2)) W:'$G(PSAERR) !,PSASLN,!
I $G(PSAERR) W !!,"The following line numbers' status cannot be changed to Verified.",!,"The fields that contain an error or need data are listed with the line item.",!,PSASLN,!
Q
;
STATUS ;Sets invoice's status to Verified
;
;PSA*3*3 (DAVE B)
S DA=PSAIEN1,DA(1)=PSAIEN,DIE="^PSD(58.811,"_DA(1)_",1,",DR="2///V;12////^S X="_DUZ
F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
D ^DIE L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
K DIE
Q
;
VERIFY ;Set line item to verified
I PSADRG,$P($G(^PSDRUG(PSADRG,2)),"^",3)["N" S PSACSLN=1
E S PSACSLN=0
K DA S DA=PSALINE,DA(1)=PSAIEN1,DA(2)=PSAIEN,DIE="^PSD(58.811,"_DA(2)_",1,"_DA(1)_",1,",DR="7///^S X="_DT_";8////^S X="_DUZ_";12///^S X=PSACSLN"
F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
D ^DIE L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
K DIE
Q
;
VERIFY1 ;NEW CODE - Set adjs if entire invioce was verified
S DA=0 F S DA=$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,DA)) Q:'DA D
.Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,DA,0))
.Q:$P(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,DA,0),"^",9)=DUZ
.S PSADJ=$P(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,DA,0),"^",2)
.S:$P(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,DA,0),"^",6) PSADJ=$P(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,DA,0),"^",6) ;p82
.S PSAREA="" D ADJ^PSAVER2
Q
;
DDQOR ;Extended help for 'Edit field'
W !?5,"Enter the number or range of numbers of the field you want to edit.",!?5,"For example, 1-3 or 1,3"
Q
LNHELP ;Extended help for 'Line Number"
W !?5,"Enter the number of the item on the invoice you want to edit.",!?5,"You may enter several line item numbers separated by comas.",!!?5,"Do NOT enter a range of numbers separated by a dash."
Q
PRINTYN ;Extended help for 'Print verification report'
W !?5,"Enter YES to print the Verification Error Report on a printer.",!?5,"Enter NO if you do not want to print the report."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAVER3 10007 printed Sep 23, 2025@19:27:06 Page 2
PSAVER3 ;BIR/JMB-Verify Invoices - CONT'D ;9/5/97
+1 ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,19,21,64,70,82**;10/24/97;Build 4
+2 ;This routine checks for verification errors, prints an error report,
+3 ;& changes data in DA ORDERS to verification if there are no errors.
+4 ;
+5 ;References to ^DIC(51.5 are covered by IA #1931
+6 ;References to ^PSDRUG( are covered by IA #2095
+7 ;
SETLINE ;Set line as verified if all data is present.
+1 KILL PSADRG,PSAOU,PSAQTY
SET (PSADJN,PSADJ)=0
+2 SET PSADATA=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0))
+3 IF $ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,0))
Begin DoDot:1
+4 SET PSAA=$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,0))
if PSAA=2
QUIT
+5 SET PSADJ=0
FOR
SET PSADJ=$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ))
if 'PSADJ
QUIT
Begin DoDot:2
+6 if '$DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
QUIT
+7 SET PSADJN=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)
+8 IF $PIECE(PSADJN,"^")="D"
Begin DoDot:3
+9 IF (+$PIECE(PSADJN,"^",9)&($PIECE(PSADJN,"^",6)'?.N))!('+$PIECE(PSADJN,"^",9)&(+$PIECE(PSADJN,"^",5))&($PIECE(PSADJN,"^",2)'?.N))
SET PSASUP=PSASUP+1
SET PSALNSU=1
SET PSADRG=0
QUIT
+10 SET PSADRG=$SELECT($PIECE(PSADJN,"^",6)'="":$PIECE(PSADJN,"^",6),$PIECE(PSADJN,"^",2)'="":$PIECE(PSADJN,"^",2),1:0)
End DoDot:3
+11 IF $PIECE(PSADJN,"^")="O"
SET PSAOU=$SELECT(+$PIECE(PSADJN,"^",6):+$PIECE(PSADJN,"^",6),+$PIECE(PSADJN,"^",2):+$PIECE(PSADJN,"^",2),1:0)
+12 IF $PIECE(PSADJN,"^")="Q"
SET PSAQTY=$SELECT($PIECE(PSADJN,"^",6)'="":+$PIECE(PSADJN,"^",6),$PIECE(PSADJN,"^",2)'="":+$PIECE(PSADJN,"^",2),1:0)
End DoDot:2
End DoDot:1
+13 if '$GET(PSADRG)
SET PSADRG=+$PIECE(PSADATA,"^",2)
if '$DATA(PSAQTY)
SET PSAQTY=+$PIECE(PSADATA,"^",3)
+14 ;DAVE B (13SEP99) PSA*3*19 If item is supply, skip this area
+15 IF $GET(PSALNSU)=1
IF $GET(PSADRG)=0
IF $GET(PSASUP)>0
GOTO SUPPLY
+16 SET PSATEMP=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2))
SET PSANDC=$PIECE(PSADATA,"^",11)
+17 ;DAVE B (PSA*3*19) Check for exisitence of NDC
+18 ;NDC may be zero
SET PSASUB=$SELECT(+$PIECE(PSATEMP,"^",3):+$PIECE(PSATEMP,"^",3),1:0)
+19 IF $GET(PSANDC)'=""
IF $GET(PSANDC)'=0
IF $GET(PSADRG)'=""
IF $GET(PSADRG)'=0
IF $DATA(^PSDRUG("C",PSANDC,PSADRG))
SET PSASUB=$SELECT($GET(PSASUB):$GET(PSASUB),+$ORDER(^PSDRUG("C",PSANDC,PSADRG,0)):+$ORDER(^PSDRUG("C",PSANDC,PSADRG,0)),1:0)
+20 SET PSADUOU=+$PIECE(PSATEMP,"^")
SET PSAREORD=+$PIECE(PSATEMP,"^",2)
SET PSASTOCK=+$PIECE(PSATEMP,"^",4)
+21 IF '$DATA(PSAOU)
Begin DoDot:1
+22 IF +$PIECE(PSADATA,"^",4)
IF $PIECE($GET(^DIC(51.5,+$PIECE(PSADATA,"^",4),0)),"^")'=""
SET PSAOU=+$PIECE(PSADATA,"^",4)
QUIT
+23 IF PSADRG
IF PSASUB
IF $PIECE($GET(^PSDRUG(PSADRG,1,PSASUB,0)),"^",5)
SET PSAOU=$PIECE($GET(^PSDRUG(PSADRG,1,PSASUB,0)),"^",5)
QUIT
+24 IF $PIECE(PSATEMP,"^",5)'=""
IF +$PIECE($PIECE(PSATEMP,"^",5),"~",2)
SET PSAOU=+$PIECE($PIECE(PSATEMP,"^",5),"~",2)
End DoDot:1
+25 IF PSASUB
Begin DoDot:1
+26 ;Next line added 8APR98 (Dave B)
+27 SET PSALOC=$SELECT($GET(PSALOC)'="":PSALOC,1:$SELECT($PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",12):$PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",12),$PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",5):$PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",
5),1:0))
+28 if 'PSADUOU
SET PSADUOU=$SELECT(PSADRG&(+$PIECE($GET(^PSDRUG(PSADRG,1,PSASUB,0)),"^",7)):+$PIECE($GET(^PSDRUG(PSADRG,1,PSASUB,0)),"^",7),1:1)
+29 if 'PSASTOCK
SET PSASTOCK=$SELECT(PSADRG:+$PIECE($GET(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",3),1:0)
+30 if 'PSAREORD
SET PSAREORD=$SELECT(PSADRG:+$PIECE($GET(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",5),1:0)
End DoDot:1
+31 ;
SUPPLY ;If it is a supply, automatically verify it.
+1 IF '+$GET(PSAERR)
IF PSALNSU
IF '$GET(PSAPRINT)
DO VERIFY
DO VERIFY1
QUIT
+2 ;; <PSA*3*70 RJS
if $GET(PSASUP)&(+$GET(PSAERR))
QUIT
+3 ;
NEWDRUG ;Store in array if drug is new to location/vault
+1 IF +PSADRG
Begin DoDot:1
+2 IF $PIECE($GET(^PSDRUG(PSADRG,2)),"^",3)["N"
IF +$PIECE(PSAIN,"^",12)
IF '$DATA(^PSD(58.8,+$PIECE(PSAIN,"^",12),1,PSADRG,0))
Begin DoDot:2
+3 SET PSAHOLD(+$PIECE(PSAIN,"^",12),PSAIEN,PSAIEN1,$SELECT($PIECE($GET(^PSDRUG(PSADRG,0)),"^")'="":$PIECE($GET(^PSDRUG(PSADRG,0)),"^"),1:"UNKNOWN"))=PSADRG
SET $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),"^",10)=1
End DoDot:2
+4 IF $PIECE($GET(^PSDRUG(PSADRG,2)),"^",3)'["N"
IF +$PIECE(PSAIN,"^",5)
IF '$DATA(^PSD(58.8,+$PIECE(PSAIN,"^",5),1,PSADRG,0))
Begin DoDot:2
+5 SET PSAHOLD(+$PIECE(PSAIN,"^",5),PSAIEN,PSAIEN1,$SELECT($PIECE($GET(^PSDRUG(PSADRG,0)),"^")'="":$PIECE($GET(^PSDRUG(PSADRG,0)),"^"),1:"UNKNOWN"))=PSADRG
SET $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),"^",10)=0
End DoDot:2
End DoDot:1
+6 ;
NOTSUP ;If it is not a supply, look for drug, qty, dispense units, dispense
+1 ;units/order unit, order unit, location/master vault, & reorder level
+2 IF '+$PIECE(PSADATA,"^",2)&('$GET(PSADRG))
SET PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$GET(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_"D"
+3 IF $PIECE(PSADATA,"^",3)=""&($GET(PSAQTY)="")
SET PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$GET(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_"Q"
+4 IF $PIECE($GET(^PSDRUG(PSADRG,660)),"^",8)=""
SET PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$GET(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_8
+5 IF '+$PIECE($GET(^PSDRUG(PSADRG,1,+PSASUB,0)),"^",7)&('+$GET(PSADUOU))
SET PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$GET(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_"U"
+6 IF '+$PIECE(PSADATA,"^",4)&('$GET(PSAOU))
SET PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$GET(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_"O"
+7 ;
+8 IF $PIECE($GET(^PSDRUG(PSADRG,2)),"^",3)'["N"
Begin DoDot:1
+9 IF '+$PIECE(PSAIN,"^",5)
SET PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$GET(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_"P"
DO CS^PSAVER5
+10 SET $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),"^",10)=0
SET PSADATA=^(0)
End DoDot:1
+11 IF $PIECE(PSAIN,"^",8)="N"!($PIECE(PSAIN,"^",8)="S")
IF '+$PIECE(PSAIN,"^",5)
IF $GET(PSANOVER(PSAIEN,PSAIEN1,PSALINE))'["P"
SET PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$GET(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_"P"
+12 ;
+13 IF $PIECE($GET(^PSDRUG(PSADRG,2)),"^",3)["N"
Begin DoDot:1
+14 IF '+$PIECE(PSAIN,"^",12)
SET PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$GET(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_"M"
DO CS^PSAVER5
+15 SET $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),"^",10)=1
SET PSADATA=^(0)
End DoDot:1
+16 IF $PIECE(PSAIN,"^",8)="A"!($PIECE(PSAIN,"^",8)="S")
IF '+$PIECE(PSAIN,"^",12)
IF $GET(PSANOVER(PSAIEN,PSAIEN1,PSALINE))'["M"
SET PSANOVER(PSAIEN,PSAIEN1,PSALINE)=$GET(PSANOVER(PSAIEN,PSAIEN1,PSALINE))_"M"
+17 ;
+18 if $DATA(PSANOVER(PSAIEN,PSAIEN1,PSALINE))
SET PSAERR=PSAERR+1
SET PSALNERR=1
+19 IF 'PSAERR
DO GOOD
QUIT
+20 QUIT
+21 ;
GOOD ;If no errors found, verify invoice.
+1 DO VERIFY
DO VERIFY1
+2 SET PSAL=0
FOR
SET PSAL=+$ORDER(PSAHOLD(PSAL))
if 'PSAL
QUIT
Begin DoDot:1
+3 SET PSANAME=""
FOR
SET PSANAME=$ORDER(PSAHOLD(PSAL,PSAIEN,PSAIEN1,PSANAME))
if PSANAME=""
QUIT
Begin DoDot:2
+4 SET PSANEWD(PSAL,PSANAME)=PSAHOLD(PSAL,PSAIEN,PSAIEN1,PSANAME)
End DoDot:2
End DoDot:1
+5 KILL PSAHOLD
+6 QUIT
+7 ;
PRINT ;Prints verification error list
+1 SET DIR(0)="Y"
SET DIR("A")="Do you want to print the verification error report"
SET DIR("B")="N"
+2 SET DIR("?",1)="Enter YES if you want to print the report just displayed."
SET DIR("?")="Enter NO if you do not want to print the report."
SET DIR("??")="^D PRINTYN^PSAVER3"
+3 DO ^DIR
KILL DIR
IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
QUIT
+4 if Y=""!('+Y)
QUIT
+5 WRITE !
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+6 IF $DATA(IO("Q"))
Begin DoDot:1
+7 SET ZTDESC="Drug Acct. - Print Prime Vendor Invoices"
SET ZTRTN="PRN^PSAVER3"
+8 IF $ORDER(PSANOVER(0))'=""
SET ZTSAVE("PSANOVER(")=""
+9 FOR PSASAVE="PSAIN","PSASLN"
if $DATA(@PSASAVE)
SET ZTSAVE(PSASAVE)=""
+10 DO ^%ZTLOAD
End DoDot:1
QUIT
PRN ;Entry point to print verification errors
+1 SET (PSAERR,PSALINE,PSAOUT,PSAPG)=0
SET PSAPRINT=1
+2 SET PSAIEN=0
FOR
SET PSAIEN=$ORDER(PSANOVER(PSAIEN))
if 'PSAIEN!(PSAOUT)
QUIT
Begin DoDot:1
+3 if '$DATA(^PSD(58.811,PSAIEN,0))
QUIT
SET PSAORD=$PIECE(^PSD(58.811,PSAIEN,0),"^")
+4 SET PSAIEN1=0
FOR
SET PSAIEN1=$ORDER(PSANOVER(PSAIEN,PSAIEN1))
if 'PSAIEN1!(PSAOUT)
QUIT
Begin DoDot:2
+5 if '$DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,0))
QUIT
SET PSAIN=^PSD(58.811,PSAIEN,1,PSAIEN1,0)
SET PSAINV=$PIECE(PSAIN,"^")
+6 SET PSALINE=0
FOR
SET PSALINE=$ORDER(PSANOVER(PSAIEN,PSAIEN1,PSALINE))
if 'PSALINE!(PSAOUT)
QUIT
Begin DoDot:3
+7 DO NOVER
End DoDot:3
End DoDot:2
+8 KILL PSANOVER(PSAIEN)
End DoDot:1
+9 WRITE !!,"** The invoice has not been placed in a Verified status!",!
+10 if $EXTRACT(IOST,1,2)="C-"
DO END^PSAPROC
if $EXTRACT(IOST)'="C"
WRITE @IOF
+11 DO ^%ZISC
+12 QUIT
+13 ;
NOVER ;Prints errors
+1 SET PSANO=PSANOVER(PSAIEN,PSAIEN1,PSALINE)
SET PSALEN=$LENGTH(PSANO)
+2 SET PSALINEN=$PIECE($GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)),"^")
SET PSATAB=$LENGTH(PSALINEN)+8
+3 IF $EXTRACT(IOST,1,2)="C-"
if 'PSAPG
DO HDR
IF $Y+(4+PSALEN)>IOSL
DO END^PSAPROC
if PSAOUT
QUIT
DO HDR
+4 IF $EXTRACT(IOST)'="C"
IF $Y+(4+PSALEN)>IOSL!('PSAPG)
DO HDR
+5 WRITE "Line# "_PSALINEN_": "
+6 if PSANO[8
WRITE ?PSATAB,"Dispense unit",!
+7 if PSANO["U"
WRITE ?PSATAB,"Dispense unit per order unit",!
+8 if PSANO["D"
WRITE ?PSATAB,"Drug",!
+9 IF PSANO["M"
WRITE ?PSATAB,"Master Vault",!
+10 if PSANO["O"
WRITE ?PSATAB,"Order unit",!
+11 IF PSANO["P"
WRITE ?PSATAB,"Pharmacy location",!
+12 if PSANO["Q"
WRITE ?PSATAB,"Quantity",!
+13 WRITE !
+14 QUIT
+15 ;
HDR ;Prints header
+1 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF,!?23,"<<< VERIFICATION ERROR REPORT >>>"
+2 IF $EXTRACT(IOST)'="C"
if PSAPG'=1
WRITE @IOF
WRITE !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",!?27,"VERIFICATION ERROR REPORT",?72,"Page "_PSAPG,!
+3 SET PSAPG=PSAPG+1
+4 WRITE !,"Order#: "_PSAORD_" Invoice#: "_$PIECE(PSAIN,"^")_" Invoice Date: "_$$FMTE^XLFDT(+$PIECE(PSAIN,"^",2))
if '$GET(PSAERR)
WRITE !,PSASLN,!
+5 IF $GET(PSAERR)
WRITE !!,"The following line numbers' status cannot be changed to Verified.",!,"The fields that contain an error or need data are listed with the line item.",!,PSASLN,!
+6 QUIT
+7 ;
STATUS ;Sets invoice's status to Verified
+1 ;
+2 ;PSA*3*3 (DAVE B)
+3 SET DA=PSAIEN1
SET DA(1)=PSAIEN
SET DIE="^PSD(58.811,"_DA(1)_",1,"
SET DR="2///V;12////^S X="_DUZ
+4 FOR
LOCK +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF $TEST
QUIT
+5 DO ^DIE
LOCK -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
+6 KILL DIE
+7 QUIT
+8 ;
VERIFY ;Set line item to verified
+1 IF PSADRG
IF $PIECE($GET(^PSDRUG(PSADRG,2)),"^",3)["N"
SET PSACSLN=1
+2 IF '$TEST
SET PSACSLN=0
+3 KILL DA
SET DA=PSALINE
SET DA(1)=PSAIEN1
SET DA(2)=PSAIEN
SET DIE="^PSD(58.811,"_DA(2)_",1,"_DA(1)_",1,"
SET DR="7///^S X="_DT_";8////^S X="_DUZ_";12///^S X=PSACSLN"
+4 FOR
LOCK +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF $TEST
QUIT
+5 DO ^DIE
LOCK -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
+6 KILL DIE
+7 QUIT
+8 ;
VERIFY1 ;NEW CODE - Set adjs if entire invioce was verified
+1 SET DA=0
FOR
SET DA=$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,DA))
if 'DA
QUIT
Begin DoDot:1
+2 if '$DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,DA,0))
QUIT
+3 if $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,DA,0),"^",9)=DUZ
QUIT
+4 SET PSADJ=$PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,DA,0),"^",2)
+5 ;p82
if $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,DA,0),"^",6)
SET PSADJ=$PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,DA,0),"^",6)
+6 SET PSAREA=""
DO ADJ^PSAVER2
End DoDot:1
+7 QUIT
+8 ;
DDQOR ;Extended help for 'Edit field'
+1 WRITE !?5,"Enter the number or range of numbers of the field you want to edit.",!?5,"For example, 1-3 or 1,3"
+2 QUIT
LNHELP ;Extended help for 'Line Number"
+1 WRITE !?5,"Enter the number of the item on the invoice you want to edit.",!?5,"You may enter several line item numbers separated by comas.",!!?5,"Do NOT enter a range of numbers separated by a dash."
+2 QUIT
PRINTYN ;Extended help for 'Print verification report'
+1 WRITE !?5,"Enter YES to print the Verification Error Report on a printer.",!?5,"Enter NO if you do not want to print the report."
+2 QUIT
