PSAPROC6 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;10/7/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21,34,50**; 10/24/97
;
;This routine allows the user to edit invoices by selecting the
;invoice's line item number.
;
;References to ^PSDRUG( are covered by IA #2095
;
SEL ;Loops thru selected invoices
F PSAPC=1:1 S PSAMENU=$P(PSASEL,",",PSAPC) Q:'PSAMENU!(PSAOUT) D CORR Q:PSAOUT D CHECK
Q ;; <= *50 TO QUIT PROPERLY
;
CHECK ;Looks to see if all line items are processed
S (PSACS,PSAERR,PSALINE,PSALINES,PSALNCNT,PSALNSU,PSAOUT,PSASUP)=0
F S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE D
.S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE),PSALNCNT=PSALNCNT+1
.S:$P(PSADATA,"^",18)="P"!($P(PSADATA,"^",18)="OK") PSALINES=PSALINES+1
.S:$P(PSADATA,"^",19)="CS" PSACS=PSACS+1
I PSACS,PSALNCNT=PSACS D
.S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",10)="ALL CS",$P(^("IN"),"^",9)="CS" W !,"All drugs on the invoice are marked as a controlled substance."
.D:$P($G(^PSD(58.8,+$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",12),0)),"^",2)'="M" MASTER^PSAPROC9
E S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",10)=""
I PSACS S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",9)="CS"
I +PSALNCNT,PSALNCNT=PSALINES D CHG D END^PSAPROC Q
E W !!,"** The invoice has not been placed in a Processed status!"
D END^PSAPROC
Q
;
CHG ;Asks if invoice's status should be changed to verified. If so, status
;is changed & new drugs to location is listed.
W ! S DIR(0)="Y",DIR("A")="Do you want to change the invoice's status to Processed",DIR("?",1)="Enter YES to change the invoice's status to Processed.",DIR("?")="Enter NO to keep the invoice's status as Uploaded."
S DIR("??")="^D CHGYN^PSAPROC6" D ^DIR K DIR
I 'Y!($G(DIRUT)) S PSACHG=0,$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",8)="" W !!,"** The invoice's status has not been changed to Processed." Q
S PSACHG=+Y,$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",8)="P"
K PSAERR(PSAMENU) ;*50 rid select (1-0)
W !!,"The invoice status has been changed to Processed!"
;
;PSA*3*21 (1/3/01 - file data in 58.811)
D ^PSAPROC7
;
Q
;
CORR S PSACTRL=$P(PSAERR(PSAMENU),"^",3),(PSALNCNT,PSALINES,PSACS)=0
S PSAIN=^XTMP("PSAPV",PSACTRL,"IN"),PSARECD=$S(+$P(PSAIN,"^",11):+$P(PSAIN,"^",11),+$P(PSAIN,"^",6):+$P(PSAIN,"^",6),1:""),PSALOC=+$P(PSAIN,"^",7),PSAMV=+$P(PSAIN,"^",12)
D HDR,RECD^PSAPROC3 Q:PSAOUT
LOC I $P(PSAIN,"^",9)="CS" W !!,"MASTER VAULT: "_$P($G(^PSD(58.8,PSAMV,0)),"^") D MV Q:PSAOUT
I $P(PSAIN,"^",10)="" D Q:PSAOUT
.;OIFO BAY PINES;TEH;PATCH PSA*3.0*34
.D SITES^PSAUTL1 S PSALOCN=$S($D(^PSD(58.8,PSALOC,0)):$P($G(^PSD(58.8,PSALOC,0)),"^"),1:"UNKNOWN")_PSACOMB
.W !!,"PHARMACY LOCATION: "
.W:$L(PSALOCN)>76 !,$P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<77 !,PSALOCN D PHARM
LINES S PSADONE=0 F W !!,"Line Item Numbers: " D Q:PSAOUT!(PSADONE)
.S PSALINE=0 S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE W ?19,PSALINE
.F S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE D
..I $X+$L(PSALINE)+2>79 W !,?19,PSALINE Q
..W ","_PSALINE
.W ! S DIR(0)="LO",DIR("A")="Select Line Item Number",DIR("?")="Enter the line numbers to be edited",DIR("??")="^D LNHELP^PSAPROC6"
.D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
.I X="" S PSADONE=1 Q
.S PSALINE=X
.I '$D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) W !,"Invalid line number." Q
.S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
.S PSAIEN=$S(+$P(PSADATA,"^",15):+$P(PSADATA,"^",15),1:+$P(PSADATA,"^",6))
.S PSANDC=$P($P(PSADATA,"^",4),"~"),PSAVSN=$P($P(PSADATA,"^",5),"~"),PSASUB=+$P(PSADATA,"^",7),PSASUP=0
.S PSALOC=$S($P(PSADATA,"^",19)="CS":+$P(PSAIN,"^",12),1:+$P(PSAIN,"^",7))
.D EDITDISP^PSAUTL1 W !,PSASLN,!
.D EDITITEM ;*50 ready for patch *54 make an entry point
Q
EDITITEM ;perform edit and checks on an item *50 to be ready for *54
D
.W "1. Drug",!,"2. Quantity Received",!,"3. Order Unit",!,"4. Dispense Units per Order Unit" S PSACHO=4
.I +$P($G(^PSD(58.8,PSALOC,0)),"^",14) W !,"5. Stock Level",!,"6. Reorder Level" S PSACHO=6
.W ! S DIR(0)="LO^1:"_PSACHO,DIR("A")="Edit fields",DIR("?")="Enter the number(s) of the data to be edited",DIR("??")="^D DQOR^PSAPROC6"
.D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
.Q:Y="" S PSAFLDS=Y,PSADU=0 D EDITDISP^PSAUTL1 W !,PSASLN
FIELDS .F PSAPCF=1:1 S PSAFLD=$P(PSAFLDS,",",PSAPCF) Q:'PSAFLD!(PSAOUT) D
..I PSAFLD=1 D ASKDRUG^PSANDF Q
..I PSAFLD=2 D QTY^PSAPROC3 Q
..I PSAFLD=3 D GETOU^PSAPROC3 Q
..I PSAFLD=4,PSAIEN D:$P($G(^PSDRUG(PSAIEN,660)),"^",8)="" DU^PSAPROC8 D DUOU^PSAPROC3 Q
..I PSAFLD=5 D STOCK^PSAPROC8 Q
..I PSAFLD=6 D REORDER^PSAPROC8
.D:'PSAOUT PROCESS
Q
;
PROCESS ;Checks for & prompts for missing data.
Q:$D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"))
S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
S PSAIEN=$S(+$P(PSADATA,"^",15):+$P(PSADATA,"^",15),+$P(PSADATA,"^",6):+$P(PSADATA,"^",6),1:0),PSASUB=+$P(PSADATA,"^",7)
;If no order unit, store it.
I '+$P($P(PSADATA,"^",2),"~",2),'$P(PSADATA,"^",12) D Q:PSAOUT
.I PSAIEN,PSASUB,'$P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",5) D GETOU^PSAPROC3 Q
.I PSAIEN,'PSASUB D GETOU^PSAPROC3
;If synonym & doesn't have disp units/order unit, store it 50.
I PSAIEN,PSASUB,'+$P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",7),'+$P(PSADATA,"^",20) S PSADU=0 D DUOU^PSAPROC8 Q:PSAOUT
;If no synonym & disp units/order unit, store it XTMP.
I PSAIEN,'PSASUB,'$P(PSADATA,"^",20) D DUOU^PSAPROC3 Q:PSAOUT
I '+$P(PSADATA,"^",3) D PRICE^PSAPROC3 Q:PSAOUT
;If not CS & maintains stock, prompt for stock & reorder levels
I $P(PSADATA,"^",19)'="CS",+$P(PSAIN,"^",7),+$P($G(^PSD(58.8,+$P(PSAIN,"^",7),0)),"^",14) D
.I '+$P($G(^PSD(58.8,+$P(PSAIN,"^",7),1,PSAIEN,0)),"^",3),'+$P(PSADATA,"^",27) S PSALOC=$P(PSAIN,"^",7) D STOCK^PSAPROC8 Q:PSAOUT
.I '+$P($G(^PSD(58.8,+$P(PSAIN,"^",7),1,PSAIEN,0)),"^",5),'+$P(PSADATA,"^",21) S PSALOC=$P(PSAIN,"^",7) D REORDER^PSAPROC8 Q:PSAOUT
;If CS & maintains stock, prompt for stock & reorder level
I $P(PSADATA,"^",19)="CS",+$P(PSAIN,"^",12),+$P($G(^PSD(58.8,+$P(PSAIN,"^",12),0)),"^",14) D
.I '+$P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSAIEN,0)),"^",3),'+$P(PSADATA,"^",27) S PSALOC=$P(PSAIN,"^",12) D STOCK^PSAPROC8 Q:PSAOUT
.I '+$P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSAIEN,0)),"^",5),'+$P(PSADATA,"^",21) S PSALOC=$P(PSAIN,"^",12) D REORDER^PSAPROC8 Q:PSAOUT
Q:PSAOUT D CHECK^PSANDF Q:PSAOUT D SETLINE^PSAPROC3
Q
;
MV ;Assigns master vault
S DIC("A")="Select Master Vault: ",DIC="^PSD(58.8,",DIC(0)="QAEMZ" S:+PSAMV DIC("B")=$P($G(^PSD(58.8,+PSAMV,0)),"^")
S DIC("S")="I $D(^PSD(58.8,""ADISP"",""M"",+Y)),'+$G(^PSD(58.8,+Y,""I""))!(+$G(^PSD(58.8,+Y,""I""))&(+$G(^PSD(58.8,+Y,""I""))'<DT))"
D ^DIC K DIC I $G(DTOUT)!($G(DUOUT))!(Y<0) S PSAOUT=1 Q
S PSAMV=+Y,$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=+Y,PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
Q
;
PHARM ;Assigns pharmacy location
;S DIC("A")="Select Pharmacy Location: ",DIC="^PSD(58.8,",DIC(0)="QAEMZ" S:+PSALOC DIC("B")=$P($G(^PSD(58.8,+PSALOC,0)),"^")
;S DIC("S")="I $D(^PSD(58.8,""ADISP"",""P"",+Y)),'$G(^PSD(58.8,+Y,""I""))!(+$G(^PSD(58.8,+Y,""I""))&(+$G(^PSD(58.8,+Y,""I""))'<DT))"
;D ^DIC K DIC I $G(DTOUT)!($G(DUOUT))!(Y<0) S PSAOUT=1 Q
;S PSALOC=+Y,$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=+Y,PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
;Dave Blocker (PSA*3*21)
D ^PSAUTL5 Q:$G(PSALOC)'>0 S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=+PSALOC,PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
;Eop
Q
;
SUPPLY ;Asks if all items are supply items. If so, invoice is deleted from
;^XTMP global. If not, invoice is added to list of invoices to be edited.
W ! S DIR(0)="Y",DIR("A")="Are all the items on the invoice supply items",DIR("B")="N"
S DIR("?",1)="Enter YES if all line items are not drugs in the DRUG file.",DIR("?")="Enter NO if there is at least one line item that is in the DRUG file."
S DIR("??")="^D ALLSUP^PSAPROC6" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
G:'Y NO
W ! S DIR(0)="Y",DIR("A")="Are you sure",DIR("B")="Y",DIR("?",1)="Enter YES if all the line items on the invoice are supply items.",DIR("?")="Enter NO if there is at least one item on the invoice that is not a supply."
S DIR("??")="^D ALLSUP^PSAPROC6" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
NO I 'Y S PSACNTER=PSACNTER+1,PSAERR(PSACNTER)=PSAOK(PSA) K PSAOK(PSA) Q
K PSAOK(PSA) S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",8)="P",PSASUP=1,PSALINE=0
F S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE D
.S ^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")=DUZ_"^"_DT_"^"_"SUPPLY ITEM",$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",18)="P"
Q
;
HDR ;Screen header
W @IOF,!?26,"<<< EDIT INVOICE SCREEN >>>",!,"Order#: "_$P(PSAIN,"^",4)_" Invoice#: "_$P(PSAIN,"^",2)_" Invoice Date: "_$$FMTE^XLFDT(+PSAIN),!,PSASLN
Q
;
CHGYN ;Extended help - 'Do you want to change the invoice's status to Processed'
W !?5,"Enter YES if the invoice is completely correct. You will not be able",!?5,"to edit it again."
W !!?5,"Enter NO if you need to edit the invoice again. You can edit it again",!?5,"by selecting the Process Orders option."
Q
DQOR ;Extended help - 'Edit field'
W !?5,"Enter the number or range of numbers of the field you want to edit."
Q
LNHELP ;Extended help - 'Line Number"
W !?5,"Enter the number of the item on the invoice you want to edit. You can",!?5,"enter a line item number then edit that line item. The ""Line Number""",!?5,"prompt will be displayed again. You can keep entering and editing line"
W !?5,"items until you press the Return key at the ""Line Number"" prompt."
Q
ALLSUP ;Extended help - "Are all the items on the invoice supply items" &
;"Are you sure?"
W !!?5,"Enter YES if none of the line items on the invoice are",!?5,"in the DRUG file and will never be in the DRUG file.",!!?5,"Enter NO if there is at least one line item on the",!?5,"invoice that is in the DRUG file."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAPROC6 9933 printed Dec 13, 2024@01:50:09 Page 2
PSAPROC6 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;10/7/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21,34,50**; 10/24/97
+2 ;
+3 ;This routine allows the user to edit invoices by selecting the
+4 ;invoice's line item number.
+5 ;
+6 ;References to ^PSDRUG( are covered by IA #2095
+7 ;
SEL ;Loops thru selected invoices
+1 FOR PSAPC=1:1
SET PSAMENU=$PIECE(PSASEL,",",PSAPC)
if 'PSAMENU!(PSAOUT)
QUIT
DO CORR
if PSAOUT
QUIT
DO CHECK
+2 ;; <= *50 TO QUIT PROPERLY
QUIT
+3 ;
CHECK ;Looks to see if all line items are processed
+1 SET (PSACS,PSAERR,PSALINE,PSALINES,PSALNCNT,PSALNSU,PSAOUT,PSASUP)=0
+2 FOR
SET PSALINE=$ORDER(^XTMP("PSAPV",PSACTRL,"IT",PSALINE))
if 'PSALINE
QUIT
Begin DoDot:1
+3 SET PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
SET PSALNCNT=PSALNCNT+1
+4 if $PIECE(PSADATA,"^",18)="P"!($PIECE(PSADATA,"^",18)="OK")
SET PSALINES=PSALINES+1
+5 if $PIECE(PSADATA,"^",19)="CS"
SET PSACS=PSACS+1
End DoDot:1
+6 IF PSACS
IF PSALNCNT=PSACS
Begin DoDot:1
+7 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",10)="ALL CS"
SET $PIECE(^("IN"),"^",9)="CS"
WRITE !,"All drugs on the invoice are marked as a controlled substance."
+8 if $PIECE($GET(^PSD(58.8,+$PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",12),0)),"^",2)'="M"
DO MASTER^PSAPROC9
End DoDot:1
+9 IF '$TEST
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",10)=""
+10 IF PSACS
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",9)="CS"
+11 IF +PSALNCNT
IF PSALNCNT=PSALINES
DO CHG
DO END^PSAPROC
QUIT
+12 IF '$TEST
WRITE !!,"** The invoice has not been placed in a Processed status!"
+13 DO END^PSAPROC
+14 QUIT
+15 ;
CHG ;Asks if invoice's status should be changed to verified. If so, status
+1 ;is changed & new drugs to location is listed.
+2 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Do you want to change the invoice's status to Processed"
SET DIR("?",1)="Enter YES to change the invoice's status to Processed."
SET DIR("?")="Enter NO to keep the invoice's status as Uploaded."
+3 SET DIR("??")="^D CHGYN^PSAPROC6"
DO ^DIR
KILL DIR
+4 IF 'Y!($GET(DIRUT))
SET PSACHG=0
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",8)=""
WRITE !!,"** The invoice's status has not been changed to Processed."
QUIT
+5 SET PSACHG=+Y
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",8)="P"
+6 ;*50 rid select (1-0)
KILL PSAERR(PSAMENU)
+7 WRITE !!,"The invoice status has been changed to Processed!"
+8 ;
+9 ;PSA*3*21 (1/3/01 - file data in 58.811)
+10 DO ^PSAPROC7
+11 ;
+12 QUIT
+13 ;
CORR SET PSACTRL=$PIECE(PSAERR(PSAMENU),"^",3)
SET (PSALNCNT,PSALINES,PSACS)=0
+1 SET PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
SET PSARECD=$SELECT(+$PIECE(PSAIN,"^",11):+$PIECE(PSAIN,"^",11),+$PIECE(PSAIN,"^",6):+$PIECE(PSAIN,"^",6),1:"")
SET PSALOC=+$PIECE(PSAIN,"^",7)
SET PSAMV=+$PIECE(PSAIN,"^",12)
+2 DO HDR
DO RECD^PSAPROC3
if PSAOUT
QUIT
LOC IF $PIECE(PSAIN,"^",9)="CS"
WRITE !!,"MASTER VAULT: "_$PIECE($GET(^PSD(58.8,PSAMV,0)),"^")
DO MV
if PSAOUT
QUIT
+1 IF $PIECE(PSAIN,"^",10)=""
Begin DoDot:1
+2 ;OIFO BAY PINES;TEH;PATCH PSA*3.0*34
+3 DO SITES^PSAUTL1
SET PSALOCN=$SELECT($DATA(^PSD(58.8,PSALOC,0)):$PIECE($GET(^PSD(58.8,PSALOC,0)),"^"),1:"UNKNOWN")_PSACOMB
+4 WRITE !!,"PHARMACY LOCATION: "
+5 if $LENGTH(PSALOCN)>76
WRITE !,$PIECE(PSALOCN,"(IP)",1)_"(IP)",!?17,$PIECE(PSALOCN,"(IP)",2)
if $LENGTH(PSALOCN)<77
WRITE !,PSALOCN
DO PHARM
End DoDot:1
if PSAOUT
QUIT
LINES SET PSADONE=0
FOR
WRITE !!,"Line Item Numbers: "
Begin DoDot:1
+1 SET PSALINE=0
SET PSALINE=$ORDER(^XTMP("PSAPV",PSACTRL,"IT",PSALINE))
if 'PSALINE
QUIT
WRITE ?19,PSALINE
+2 FOR
SET PSALINE=$ORDER(^XTMP("PSAPV",PSACTRL,"IT",PSALINE))
if 'PSALINE
QUIT
Begin DoDot:2
+3 IF $X+$LENGTH(PSALINE)+2>79
WRITE !,?19,PSALINE
QUIT
+4 WRITE ","_PSALINE
End DoDot:2
+5 WRITE !
SET DIR(0)="LO"
SET DIR("A")="Select Line Item Number"
SET DIR("?")="Enter the line numbers to be edited"
SET DIR("??")="^D LNHELP^PSAPROC6"
+6 DO ^DIR
KILL DIR
IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
QUIT
+7 IF X=""
SET PSADONE=1
QUIT
+8 SET PSALINE=X
+9 IF '$DATA(^XTMP("PSAPV",PSACTRL,"IT",PSALINE))
WRITE !,"Invalid line number."
QUIT
+10 SET PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
+11 SET PSAIEN=$SELECT(+$PIECE(PSADATA,"^",15):+$PIECE(PSADATA,"^",15),1:+$PIECE(PSADATA,"^",6))
+12 SET PSANDC=$PIECE($PIECE(PSADATA,"^",4),"~")
SET PSAVSN=$PIECE($PIECE(PSADATA,"^",5),"~")
SET PSASUB=+$PIECE(PSADATA,"^",7)
SET PSASUP=0
+13 SET PSALOC=$SELECT($PIECE(PSADATA,"^",19)="CS":+$PIECE(PSAIN,"^",12),1:+$PIECE(PSAIN,"^",7))
+14 DO EDITDISP^PSAUTL1
WRITE !,PSASLN,!
+15 ;*50 ready for patch *54 make an entry point
DO EDITITEM
End DoDot:1
if PSAOUT!(PSADONE)
QUIT
+16 QUIT
EDITITEM ;perform edit and checks on an item *50 to be ready for *54
+1 Begin DoDot:1
+2 WRITE "1. Drug",!,"2. Quantity Received",!,"3. Order Unit",!,"4. Dispense Units per Order Unit"
SET PSACHO=4
+3 IF +$PIECE($GET(^PSD(58.8,PSALOC,0)),"^",14)
WRITE !,"5. Stock Level",!,"6. Reorder Level"
SET PSACHO=6
+4 WRITE !
SET DIR(0)="LO^1:"_PSACHO
SET DIR("A")="Edit fields"
SET DIR("?")="Enter the number(s) of the data to be edited"
SET DIR("??")="^D DQOR^PSAPROC6"
+5 DO ^DIR
KILL DIR
IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
QUIT
+6 if Y=""
QUIT
SET PSAFLDS=Y
SET PSADU=0
DO EDITDISP^PSAUTL1
WRITE !,PSASLN
FIELDS FOR PSAPCF=1:1
SET PSAFLD=$PIECE(PSAFLDS,",",PSAPCF)
if 'PSAFLD!(PSAOUT)
QUIT
Begin DoDot:2
+1 IF PSAFLD=1
DO ASKDRUG^PSANDF
QUIT
+2 IF PSAFLD=2
DO QTY^PSAPROC3
QUIT
+3 IF PSAFLD=3
DO GETOU^PSAPROC3
QUIT
+4 IF PSAFLD=4
IF PSAIEN
if $PIECE($GET(^PSDRUG(PSAIEN,660)),"^",8)=""
DO DU^PSAPROC8
DO DUOU^PSAPROC3
QUIT
+5 IF PSAFLD=5
DO STOCK^PSAPROC8
QUIT
+6 IF PSAFLD=6
DO REORDER^PSAPROC8
End DoDot:2
+7 if 'PSAOUT
DO PROCESS
End DoDot:1
+8 QUIT
+9 ;
PROCESS ;Checks for & prompts for missing data.
+1 if $DATA(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"))
QUIT
+2 SET PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
+3 SET PSAIEN=$SELECT(+$PIECE(PSADATA,"^",15):+$PIECE(PSADATA,"^",15),+$PIECE(PSADATA,"^",6):+$PIECE(PSADATA,"^",6),1:0)
SET PSASUB=+$PIECE(PSADATA,"^",7)
+4 ;If no order unit, store it.
+5 IF '+$PIECE($PIECE(PSADATA,"^",2),"~",2)
IF '$PIECE(PSADATA,"^",12)
Begin DoDot:1
+6 IF PSAIEN
IF PSASUB
IF '$PIECE($GET(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",5)
DO GETOU^PSAPROC3
QUIT
+7 IF PSAIEN
IF 'PSASUB
DO GETOU^PSAPROC3
End DoDot:1
if PSAOUT
QUIT
+8 ;If synonym & doesn't have disp units/order unit, store it 50.
+9 IF PSAIEN
IF PSASUB
IF '+$PIECE($GET(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",7)
IF '+$PIECE(PSADATA,"^",20)
SET PSADU=0
DO DUOU^PSAPROC8
if PSAOUT
QUIT
+10 ;If no synonym & disp units/order unit, store it XTMP.
+11 IF PSAIEN
IF 'PSASUB
IF '$PIECE(PSADATA,"^",20)
DO DUOU^PSAPROC3
if PSAOUT
QUIT
+12 IF '+$PIECE(PSADATA,"^",3)
DO PRICE^PSAPROC3
if PSAOUT
QUIT
+13 ;If not CS & maintains stock, prompt for stock & reorder levels
+14 IF $PIECE(PSADATA,"^",19)'="CS"
IF +$PIECE(PSAIN,"^",7)
IF +$PIECE($GET(^PSD(58.8,+$PIECE(PSAIN,"^",7),0)),"^",14)
Begin DoDot:1
+15 IF '+$PIECE($GET(^PSD(58.8,+$PIECE(PSAIN,"^",7),1,PSAIEN,0)),"^",3)
IF '+$PIECE(PSADATA,"^",27)
SET PSALOC=$PIECE(PSAIN,"^",7)
DO STOCK^PSAPROC8
if PSAOUT
QUIT
+16 IF '+$PIECE($GET(^PSD(58.8,+$PIECE(PSAIN,"^",7),1,PSAIEN,0)),"^",5)
IF '+$PIECE(PSADATA,"^",21)
SET PSALOC=$PIECE(PSAIN,"^",7)
DO REORDER^PSAPROC8
if PSAOUT
QUIT
End DoDot:1
+17 ;If CS & maintains stock, prompt for stock & reorder level
+18 IF $PIECE(PSADATA,"^",19)="CS"
IF +$PIECE(PSAIN,"^",12)
IF +$PIECE($GET(^PSD(58.8,+$PIECE(PSAIN,"^",12),0)),"^",14)
Begin DoDot:1
+19 IF '+$PIECE($GET(^PSD(58.8,+$PIECE(PSAIN,"^",12),1,PSAIEN,0)),"^",3)
IF '+$PIECE(PSADATA,"^",27)
SET PSALOC=$PIECE(PSAIN,"^",12)
DO STOCK^PSAPROC8
if PSAOUT
QUIT
+20 IF '+$PIECE($GET(^PSD(58.8,+$PIECE(PSAIN,"^",12),1,PSAIEN,0)),"^",5)
IF '+$PIECE(PSADATA,"^",21)
SET PSALOC=$PIECE(PSAIN,"^",12)
DO REORDER^PSAPROC8
if PSAOUT
QUIT
End DoDot:1
+21 if PSAOUT
QUIT
DO CHECK^PSANDF
if PSAOUT
QUIT
DO SETLINE^PSAPROC3
+22 QUIT
+23 ;
MV ;Assigns master vault
+1 SET DIC("A")="Select Master Vault: "
SET DIC="^PSD(58.8,"
SET DIC(0)="QAEMZ"
if +PSAMV
SET DIC("B")=$PIECE($GET(^PSD(58.8,+PSAMV,0)),"^")
+2 SET DIC("S")="I $D(^PSD(58.8,""ADISP"",""M"",+Y)),'+$G(^PSD(58.8,+Y,""I""))!(+$G(^PSD(58.8,+Y,""I""))&(+$G(^PSD(58.8,+Y,""I""))'<DT))"
+3 DO ^DIC
KILL DIC
IF $GET(DTOUT)!($GET(DUOUT))!(Y<0)
SET PSAOUT=1
QUIT
+4 SET PSAMV=+Y
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",12)=+Y
SET PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
+5 QUIT
+6 ;
PHARM ;Assigns pharmacy location
+1 ;S DIC("A")="Select Pharmacy Location: ",DIC="^PSD(58.8,",DIC(0)="QAEMZ" S:+PSALOC DIC("B")=$P($G(^PSD(58.8,+PSALOC,0)),"^")
+2 ;S DIC("S")="I $D(^PSD(58.8,""ADISP"",""P"",+Y)),'$G(^PSD(58.8,+Y,""I""))!(+$G(^PSD(58.8,+Y,""I""))&(+$G(^PSD(58.8,+Y,""I""))'<DT))"
+3 ;D ^DIC K DIC I $G(DTOUT)!($G(DUOUT))!(Y<0) S PSAOUT=1 Q
+4 ;S PSALOC=+Y,$P(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=+Y,PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
+5 ;Dave Blocker (PSA*3*21)
+6 DO ^PSAUTL5
if $GET(PSALOC)'>0
QUIT
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",7)=+PSALOC
SET PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
+7 ;Eop
+8 QUIT
+9 ;
SUPPLY ;Asks if all items are supply items. If so, invoice is deleted from
+1 ;^XTMP global. If not, invoice is added to list of invoices to be edited.
+2 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Are all the items on the invoice supply items"
SET DIR("B")="N"
+3 SET DIR("?",1)="Enter YES if all line items are not drugs in the DRUG file."
SET DIR("?")="Enter NO if there is at least one line item that is in the DRUG file."
+4 SET DIR("??")="^D ALLSUP^PSAPROC6"
DO ^DIR
KILL DIR
IF $GET(DIRUT)
SET PSAOUT=1
QUIT
+5 if 'Y
GOTO NO
+6 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Are you sure"
SET DIR("B")="Y"
SET DIR("?",1)="Enter YES if all the line items on the invoice are supply items."
SET DIR("?")="Enter NO if there is at least one item on the invoice that is not a supply."
+7 SET DIR("??")="^D ALLSUP^PSAPROC6"
DO ^DIR
KILL DIR
IF $GET(DIRUT)
SET PSAOUT=1
QUIT
NO IF 'Y
SET PSACNTER=PSACNTER+1
SET PSAERR(PSACNTER)=PSAOK(PSA)
KILL PSAOK(PSA)
QUIT
+1 KILL PSAOK(PSA)
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",8)="P"
SET PSASUP=1
SET PSALINE=0
+2 FOR
SET PSALINE=$ORDER(^XTMP("PSAPV",PSACTRL,"IT",PSALINE))
if 'PSALINE
QUIT
Begin DoDot:1
+3 SET ^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")=DUZ_"^"_DT_"^"_"SUPPLY ITEM"
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",18)="P"
End DoDot:1
+4 QUIT
+5 ;
HDR ;Screen header
+1 WRITE @IOF,!?26,"<<< EDIT INVOICE SCREEN >>>",!,"Order#: "_$PIECE(PSAIN,"^",4)_" Invoice#: "_$PIECE(PSAIN,"^",2)_" Invoice Date: "_$$FMTE^XLFDT(+PSAIN),!,PSASLN
+2 QUIT
+3 ;
CHGYN ;Extended help - 'Do you want to change the invoice's status to Processed'
+1 WRITE !?5,"Enter YES if the invoice is completely correct. You will not be able",!?5,"to edit it again."
+2 WRITE !!?5,"Enter NO if you need to edit the invoice again. You can edit it again",!?5,"by selecting the Process Orders option."
+3 QUIT
DQOR ;Extended help - 'Edit field'
+1 WRITE !?5,"Enter the number or range of numbers of the field you want to edit."
+2 QUIT
LNHELP ;Extended help - 'Line Number"
+1 WRITE !?5,"Enter the number of the item on the invoice you want to edit. You can",!?5,"enter a line item number then edit that line item. The ""Line Number""",!?5,"prompt will be displayed again. You can keep entering and editing line"
+2 WRITE !?5,"items until you press the Return key at the ""Line Number"" prompt."
+3 QUIT
ALLSUP ;Extended help - "Are all the items on the invoice supply items" &
+1 ;"Are you sure?"
+2 WRITE !!?5,"Enter YES if none of the line items on the invoice are",!?5,"in the DRUG file and will never be in the DRUG file.",!!?5,"Enter NO if there is at least one line item on the",!?5,"invoice that is in the DRUG file."
+3 QUIT
