PSARDCIT ;BIRM/JAM - Return Drug Credit Single Item ListMan driver ;06/06/08
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**69**;10/24/97;Build 9
;References to ORDER UNIT file (#51.5) supported by IA #1931
;
EN(PSAPHLOC,PSABATCH,PSAITEM) ; - ListManager entry point
;
D EN^VALM("PSA RETURN DRUG BATCH ITEM")
D FULL^VALM1
G EXIT
;
HDR ; - Header
D LMHDR^PSARDCUT(PSAPHLOC,PSABATCH)
Q
;
INIT ; - Populates the Body section for ListMan
K ^TMP("PSARDCIT",$J)
S VALMCNT=0
D SETLINE
S VALMSG="Enter ?? for more actions"
Q
;
SETLINE ; - Sets the line to be displayed in ListMan
N LINE,SEQ,DATA,FLDS
K ^TMP("PSARDCIT",$J)
S SEQ=0
D GETS^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC_",","*","IE","FLDS")
K DATA M DATA=FLDS(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC_",")
S LINE=" Drug: "_$E(DATA(.01,"E"),1,26),$E(LINE,44)="Credit Status: "_DATA(10,"E") D SETTMP
S LINE=" Manufacturer: "_$E(DATA(2,"E"),1,30),$E(LINE,48)="Exp. Date: "_$$FMTE^XLFDT(DATA(9,"I"),"2ZM") D SETTMP
S LINE=" NDC: "_$E(DATA(3,"E"),1,30),$E(LINE,47)="Created By: "_$E($G(DATA(16,"E")),1,22) D SETTMP
S LINE=" UPC: "_$E(DATA(4,"E"),1,30),$E(LINE,47)="Created On: "_$$FMTE^XLFDT(DATA(1,"I"),"2ZM") D SETTMP
S LINE=" Ord Unit: "_$E($$GET1^DIQ(51.5,DATA(5,"I"),.02),1,30),$E(LINE,47)="Est Credit: $"_$J(DATA(11,"E"),0,2) D SETTMP
S LINE=" Dsp Unit: "_$E(DATA(8,"E"),1,27),$E(LINE,44)="Actual Credit: $"_$J(DATA(12,"E"),0,2) D SETTMP
S LINE=" DUOU: "_$E(DATA(7,"E"),1,27),$E(LINE,44)="Return Reason: "_DATA(15,"E") D SETTMP
S LINE="Return Ord Qty: "_DATA(6,"E"),$E(LINE,43)="Upd. Inventory: "_DATA(14,"E") D SETTMP
S LINE="Return Dsp Qty: "_DATA(17,"E") D SETTMP
S LINE="" D SETTMP
S LINE="Activity Log" D SETTMP D CNTRL^VALM10(SEQ,1,80,IOUON,IOINORM)
S LINE="DATE/TIME",$E(LINE,20)="ACTION",$E(LINE,30)="USER" D SETTMP
D CNTRL^VALM10(SEQ,1,80,IOUON,IOINORM)
D ACTLOG
S VALMCNT=SEQ
Q
;
ACTLOG ; - Gets lines for activity log
N LOG,FLDS,LINE,PSALOG,I,COMM
S LOG=0
F S LOG=$O(^PSD(58.35,PSAPHLOC,"BAT",PSABATCH,"ITM",PSAITEM,"LOG",LOG)) Q:'LOG D
.D GETS^DIQ(58.35111,LOG_","_PSAITEM_","_PSABATCH_","_PSAPHLOC_",","*","IE","FLDS")
.M PSALOG=FLDS(58.35111,LOG_","_PSAITEM_","_PSABATCH_","_PSAPHLOC_",")
.S LINE=$$FMTE^XLFDT(PSALOG(.01,"I"),"2Z"),$E(LINE,20)=PSALOG(2,"E"),$E(LINE,30)=PSALOG(1,"E") D SETTMP
.S COMM=PSALOG(3,"E") I $L(COMM)>80 D
..F I=$L(COMM," "):-1:1 I $L($P(COMM," ",1,I))<80 D Q
...S LINE=$P(COMM," ",1,I) D SETTMP S LINE=$P(COMM," ",I+1,$L(COMM," ")) D SETTMP
.E S LINE=COMM D SETTMP
Q
;
SETTMP ; Set ^TMP("PSARDCIT",$J, array
S SEQ=SEQ+1,^TMP("PSARDCIT",$J,SEQ,0)=LINE
Q
;
EDT ; - Single Item Edit
N PSANODE,PSALCK,BATST
D FULL^VALM1
W ! S BATST=$$BATSTA(PSAPHLOC,PSABATCH) I '+BATST D Q
.S VALMSG=$P(BATST,"^",2),VALMBCK="R" W $C(7)
S PSANODE="^PSD(58.35,"_PSAPHLOC_",""BAT"","_PSABATCH_",""ITM"","_PSAITEM_")"
S PSALCK=$$LK(PSANODE) I 'PSALCK D W $C(7) Q
.S VALMSG="Record locked by another user. Try again later!",VALMBCK="R"
D ITEM^PSARDCU1(PSAPHLOC,PSABATCH,PSAITEM),UNLK(PSANODE),SETLINE
S VALMBCK="R"
Q
;
CAN ; - Single Item Cancel
N BATST,PSANODE,PSALCK,DIR,DIK,DA,X,Y,DRUG,UPINV,DUNTS
D FULL^VALM1
W ! S BATST=$$BATSTA(PSAPHLOC,PSABATCH) I '+BATST D Q
.S VALMSG=$P(BATST,"^",2),VALMBCK="R" W $C(7)
I $$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1,"I")="PU" D W $C(7) Q
.S VALMSG="Cannot change. This batch has been picked up",VALMBCK="R"
S PSANODE="^PSD(58.35,"_PSAPHLOC_",""BAT"","_PSABATCH_",""ITM"","_PSAITEM_")"
S PSALCK=$$LK(PSANODE) I 'PSALCK D W $C(7) Q
.S VALMSG="Record locked by another user. Try again later!",VALMBCK="R"
S DIR(0)="Y",DIR("A")=" Confirm",DIR("B")="N"
D ^DIR I ($D(DIRUT))!('Y) D Q
.S VALMSG="Cancel aborted...",VALMBCK="R" W $C(7) D UNLK(PSANODE)
S DRUG=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,.01,"I")
S UPINV=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,14,"I")
S DUNTS=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,17,"I")
;call to update inventory
I UPINV,+DUNTS>0 D UPDINV^PSARDCUT(PSAPHLOC,PSABATCH,PSAITEM,DRUG,DUNTS)
;delete record
S DA(2)=PSAPHLOC,DA(1)=PSABATCH,DA=PSAITEM
S DIK="^PSD(58.35,"_DA(2)_",""BAT"","_DA(1)_",""ITM"","
D ^DIK,UNLK(PSANODE)
S VALMSG="Item removed!",VALMBCK="Q"
Q
;
CRE ; - Single Item Credit Update
N DIR,DIRUT,DA,X,Y,BATST,PSANODE,PSALCK,PSAISTA,PSAIAMT,CREAMT,OISTA
N FLDD,PSACOM,CRESTA,ACTAMT,ESTAMT
D FULL^VALM1
W ! S BATST=$$BATSTA(PSAPHLOC,PSABATCH)
I $P(BATST,"^",2)'="PU" D S VALMBCK="R" W $C(7) Q
.S VALMSG="Batch status must be PICKED UP to update credit!"
S PSANODE="^PSD(58.35,"_PSAPHLOC_",""BAT"","_PSABATCH_",""ITM"","_PSAITEM_")"
S PSALCK=$$LK(PSANODE) I 'PSALCK D W $C(7) Q
.S VALMSG="Record locked by another user. Try again later!",VALMBCK="R"
S DIR(0)="58.3511,10",DIR("A")="CREDIT STATUS"
S OISTA=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,10,"I")
S DIR("B")=$S(OISTA="":"P",1:OISTA)
D ^DIR I $D(DIRUT) D Q
.S VALMSG="Credit Update aborted",VALMBCK="R" D UNLK(PSANODE)
S PSAISTA=Y,(PSAIAMT,CREAMT)="",CRESTA=$$EXTERNAL^DILFD(58.3511,10,,Y)
K DIR,X,Y,DA W !
;Only ask for amount when status is Actual or Estimated
I ("^A^E^")[("^"_PSAISTA_"^") D
.S FLDD=$S(PSAISTA="A":12,1:11) ;,DIR(0)="58.3511,"_FLDD
.S DIR(0)="NA^0.01:999999999:2",DIR("?")="Type a Dollar amount between 0 and 999999999, 2 Decimal Digits"
.S CREAMT=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,FLDD,"I")
.I CREAMT'="" S DIR("B")=$J(CREAMT,0,2)
.S DIR("A")=$$EXTERNAL^DILFD(58.3511,10,,PSAISTA)_" CREDIT AMOUNT: "
.D ^DIR
.S PSAIAMT=Y
I $D(DIRUT) D Q
.S VALMSG="Credit Update aborted",VALMBCK="R" W $C(7) D UNLK(PSANODE)
K DIR,X,Y,DA W !
S DIR(0)="Y",DIR("A")=" Save Credit",DIR("B")="N"
D ^DIR I $D(DIRUT)!('Y) D Q
.S VALMSG="Credit Update aborted...",VALMBCK="R" W $C(7) D UNLK(PSANODE)
; if record unchanged, quit.
I OISTA=PSAISTA,CREAMT=PSAIAMT S VALMBCK="R" Q
I OISTA'=PSAISTA D
.S PSACOM="CREDIT STATUS changed from "_$S(OISTA="":"''",1:$$EXTERNAL^DILFD(58.3511,10,,OISTA))_" to "_$$EXTERNAL^DILFD(58.3511,10,,PSAISTA)_". "
.D LOGACT^PSARDCUT(PSAPHLOC,PSABATCH,PSAITEM,"E",PSACOM)
I ("^A^E^")[("^"_PSAISTA_"^") D
.S PSACOM=$$EXTERNAL^DILFD(58.3511,10,,PSAISTA)_" CREDIT AMOUNT changed from "_$S(CREAMT="":"''",1:"$"_$J(CREAMT,0,2))_" to $"_$J(PSAIAMT,0,2)_"."
.D LOGACT^PSARDCUT(PSAPHLOC,PSABATCH,PSAITEM,"E",PSACOM)
I ("^P^D^")[("^"_PSAISTA_"^") D
.S PSACOM=""
.S ESTAMT=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,11,"I")
.I ESTAMT'="" S PSACOM="ESTIMATED CREDIT AMOUNT of $"_$J(ESTAMT,0,2)
.S ACTAMT=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,12,"I")
.I ACTAMT'="" S PSACOM=PSACOM_$S(PSACOM="":"",1:" and ")_"ACTUAL CREDIT AMOUNT of $"_$J(ACTAMT,0,2)
.I PSACOM'="" S PSACOM=PSACOM_$S(PSACOM["and":" were",1:" was")_" automatically deleted."
.I PSACOM'="" D LOGACT^PSARDCUT(PSAPHLOC,PSABATCH,PSAITEM,"E",PSACOM)
D ITMUPD,UNLK(PSANODE),HDR,SETLINE
S VALMBCK="R"
Q
;
ITMUPD ; - Single Item File Update
N PSAIENS,PSARY
S DA(2)=PSAPHLOC,DA(1)=PSABATCH,DA=PSAITEM
S PSAIENS=$$IENS^DILF(.DA)
S PSARY(58.3511,PSAIENS,10)=PSAISTA
I ("^A^E^")[("^"_PSAISTA_"^") S PSARY(58.3511,PSAIENS,FLDD)=PSAIAMT
I ("^P^D^")[("^"_PSAISTA_"^") D
.S PSARY(58.3511,PSAIENS,11)=""
.S PSARY(58.3511,PSAIENS,12)=""
D UPDATE^DIE("","PSARY")
Q
;
BATSTA(PSAPHLOC,PSABATCH) ; - Returns if a batch is editable
; Input: PSAPHLOC - Pharmacy location
; PSABATCH - Batch IEN from ^PSD(58.35,
; Output: 1^Batch Status
; 0^Error message
N BATST,MSG
S BATST=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1,"I")
I "^CO^CA^"[BATST D Q 0_"^"_MSG
.S MSG="Cannot change. This batch has been "_$S(BATST="CO":"completed.",1:"cancelled.")
Q 1_"^"_BATST
;
LK(NODE) ;- Locks node
L +@NODE:$S($G(DILOCKTM)>0:DILOCKTM,1:3) Q $T
;
UNLK(NODE) ;Unlocks node
L -@NODE
Q
EXIT ;
K ^TMP("PSARDCIT",$J)
Q
;
HELP ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSARDCIT 8105 printed Sep 23, 2025@19:26:26 Page 2
PSARDCIT ;BIRM/JAM - Return Drug Credit Single Item ListMan driver ;06/06/08
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**69**;10/24/97;Build 9
+2 ;References to ORDER UNIT file (#51.5) supported by IA #1931
+3 ;
EN(PSAPHLOC,PSABATCH,PSAITEM) ; - ListManager entry point
+1 ;
+2 DO EN^VALM("PSA RETURN DRUG BATCH ITEM")
+3 DO FULL^VALM1
+4 GOTO EXIT
+5 ;
HDR ; - Header
+1 DO LMHDR^PSARDCUT(PSAPHLOC,PSABATCH)
+2 QUIT
+3 ;
INIT ; - Populates the Body section for ListMan
+1 KILL ^TMP("PSARDCIT",$JOB)
+2 SET VALMCNT=0
+3 DO SETLINE
+4 SET VALMSG="Enter ?? for more actions"
+5 QUIT
+6 ;
SETLINE ; - Sets the line to be displayed in ListMan
+1 NEW LINE,SEQ,DATA,FLDS
+2 KILL ^TMP("PSARDCIT",$JOB)
+3 SET SEQ=0
+4 DO GETS^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC_",","*","IE","FLDS")
+5 KILL DATA
MERGE DATA=FLDS(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC_",")
+6 SET LINE=" Drug: "_$EXTRACT(DATA(.01,"E"),1,26)
SET $EXTRACT(LINE,44)="Credit Status: "_DATA(10,"E")
DO SETTMP
+7 SET LINE=" Manufacturer: "_$EXTRACT(DATA(2,"E"),1,30)
SET $EXTRACT(LINE,48)="Exp. Date: "_$$FMTE^XLFDT(DATA(9,"I"),"2ZM")
DO SETTMP
+8 SET LINE=" NDC: "_$EXTRACT(DATA(3,"E"),1,30)
SET $EXTRACT(LINE,47)="Created By: "_$EXTRACT($GET(DATA(16,"E")),1,22)
DO SETTMP
+9 SET LINE=" UPC: "_$EXTRACT(DATA(4,"E"),1,30)
SET $EXTRACT(LINE,47)="Created On: "_$$FMTE^XLFDT(DATA(1,"I"),"2ZM")
DO SETTMP
+10 SET LINE=" Ord Unit: "_$EXTRACT($$GET1^DIQ(51.5,DATA(5,"I"),.02),1,30)
SET $EXTRACT(LINE,47)="Est Credit: $"_$JUSTIFY(DATA(11,"E"),0,2)
DO SETTMP
+11 SET LINE=" Dsp Unit: "_$EXTRACT(DATA(8,"E"),1,27)
SET $EXTRACT(LINE,44)="Actual Credit: $"_$JUSTIFY(DATA(12,"E"),0,2)
DO SETTMP
+12 SET LINE=" DUOU: "_$EXTRACT(DATA(7,"E"),1,27)
SET $EXTRACT(LINE,44)="Return Reason: "_DATA(15,"E")
DO SETTMP
+13 SET LINE="Return Ord Qty: "_DATA(6,"E")
SET $EXTRACT(LINE,43)="Upd. Inventory: "_DATA(14,"E")
DO SETTMP
+14 SET LINE="Return Dsp Qty: "_DATA(17,"E")
DO SETTMP
+15 SET LINE=""
DO SETTMP
+16 SET LINE="Activity Log"
DO SETTMP
DO CNTRL^VALM10(SEQ,1,80,IOUON,IOINORM)
+17 SET LINE="DATE/TIME"
SET $EXTRACT(LINE,20)="ACTION"
SET $EXTRACT(LINE,30)="USER"
DO SETTMP
+18 DO CNTRL^VALM10(SEQ,1,80,IOUON,IOINORM)
+19 DO ACTLOG
+20 SET VALMCNT=SEQ
+21 QUIT
+22 ;
ACTLOG ; - Gets lines for activity log
+1 NEW LOG,FLDS,LINE,PSALOG,I,COMM
+2 SET LOG=0
+3 FOR
SET LOG=$ORDER(^PSD(58.35,PSAPHLOC,"BAT",PSABATCH,"ITM",PSAITEM,"LOG",LOG))
if 'LOG
QUIT
Begin DoDot:1
+4 DO GETS^DIQ(58.35111,LOG_","_PSAITEM_","_PSABATCH_","_PSAPHLOC_",","*","IE","FLDS")
+5 MERGE PSALOG=FLDS(58.35111,LOG_","_PSAITEM_","_PSABATCH_","_PSAPHLOC_",")
+6 SET LINE=$$FMTE^XLFDT(PSALOG(.01,"I"),"2Z")
SET $EXTRACT(LINE,20)=PSALOG(2,"E")
SET $EXTRACT(LINE,30)=PSALOG(1,"E")
DO SETTMP
+7 SET COMM=PSALOG(3,"E")
IF $LENGTH(COMM)>80
Begin DoDot:2
+8 FOR I=$LENGTH(COMM," "):-1:1
IF $LENGTH($PIECE(COMM," ",1,I))<80
Begin DoDot:3
+9 SET LINE=$PIECE(COMM," ",1,I)
DO SETTMP
SET LINE=$PIECE(COMM," ",I+1,$LENGTH(COMM," "))
DO SETTMP
End DoDot:3
QUIT
End DoDot:2
+10 IF '$TEST
SET LINE=COMM
DO SETTMP
End DoDot:1
+11 QUIT
+12 ;
SETTMP ; Set ^TMP("PSARDCIT",$J, array
+1 SET SEQ=SEQ+1
SET ^TMP("PSARDCIT",$JOB,SEQ,0)=LINE
+2 QUIT
+3 ;
EDT ; - Single Item Edit
+1 NEW PSANODE,PSALCK,BATST
+2 DO FULL^VALM1
+3 WRITE !
SET BATST=$$BATSTA(PSAPHLOC,PSABATCH)
IF '+BATST
Begin DoDot:1
+4 SET VALMSG=$PIECE(BATST,"^",2)
SET VALMBCK="R"
WRITE $CHAR(7)
End DoDot:1
QUIT
+5 SET PSANODE="^PSD(58.35,"_PSAPHLOC_",""BAT"","_PSABATCH_",""ITM"","_PSAITEM_")"
+6 SET PSALCK=$$LK(PSANODE)
IF 'PSALCK
Begin DoDot:1
+7 SET VALMSG="Record locked by another user. Try again later!"
SET VALMBCK="R"
End DoDot:1
WRITE $CHAR(7)
QUIT
+8 DO ITEM^PSARDCU1(PSAPHLOC,PSABATCH,PSAITEM)
DO UNLK(PSANODE)
DO SETLINE
+9 SET VALMBCK="R"
+10 QUIT
+11 ;
CAN ; - Single Item Cancel
+1 NEW BATST,PSANODE,PSALCK,DIR,DIK,DA,X,Y,DRUG,UPINV,DUNTS
+2 DO FULL^VALM1
+3 WRITE !
SET BATST=$$BATSTA(PSAPHLOC,PSABATCH)
IF '+BATST
Begin DoDot:1
+4 SET VALMSG=$PIECE(BATST,"^",2)
SET VALMBCK="R"
WRITE $CHAR(7)
End DoDot:1
QUIT
+5 IF $$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1,"I")="PU"
Begin DoDot:1
+6 SET VALMSG="Cannot change. This batch has been picked up"
SET VALMBCK="R"
End DoDot:1
WRITE $CHAR(7)
QUIT
+7 SET PSANODE="^PSD(58.35,"_PSAPHLOC_",""BAT"","_PSABATCH_",""ITM"","_PSAITEM_")"
+8 SET PSALCK=$$LK(PSANODE)
IF 'PSALCK
Begin DoDot:1
+9 SET VALMSG="Record locked by another user. Try again later!"
SET VALMBCK="R"
End DoDot:1
WRITE $CHAR(7)
QUIT
+10 SET DIR(0)="Y"
SET DIR("A")=" Confirm"
SET DIR("B")="N"
+11 DO ^DIR
IF ($DATA(DIRUT))!('Y)
Begin DoDot:1
+12 SET VALMSG="Cancel aborted..."
SET VALMBCK="R"
WRITE $CHAR(7)
DO UNLK(PSANODE)
End DoDot:1
QUIT
+13 SET DRUG=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,.01,"I")
+14 SET UPINV=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,14,"I")
+15 SET DUNTS=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,17,"I")
+16 ;call to update inventory
+17 IF UPINV
IF +DUNTS>0
DO UPDINV^PSARDCUT(PSAPHLOC,PSABATCH,PSAITEM,DRUG,DUNTS)
+18 ;delete record
+19 SET DA(2)=PSAPHLOC
SET DA(1)=PSABATCH
SET DA=PSAITEM
+20 SET DIK="^PSD(58.35,"_DA(2)_",""BAT"","_DA(1)_",""ITM"","
+21 DO ^DIK
DO UNLK(PSANODE)
+22 SET VALMSG="Item removed!"
SET VALMBCK="Q"
+23 QUIT
+24 ;
CRE ; - Single Item Credit Update
+1 NEW DIR,DIRUT,DA,X,Y,BATST,PSANODE,PSALCK,PSAISTA,PSAIAMT,CREAMT,OISTA
+2 NEW FLDD,PSACOM,CRESTA,ACTAMT,ESTAMT
+3 DO FULL^VALM1
+4 WRITE !
SET BATST=$$BATSTA(PSAPHLOC,PSABATCH)
+5 IF $PIECE(BATST,"^",2)'="PU"
Begin DoDot:1
+6 SET VALMSG="Batch status must be PICKED UP to update credit!"
End DoDot:1
SET VALMBCK="R"
WRITE $CHAR(7)
QUIT
+7 SET PSANODE="^PSD(58.35,"_PSAPHLOC_",""BAT"","_PSABATCH_",""ITM"","_PSAITEM_")"
+8 SET PSALCK=$$LK(PSANODE)
IF 'PSALCK
Begin DoDot:1
+9 SET VALMSG="Record locked by another user. Try again later!"
SET VALMBCK="R"
End DoDot:1
WRITE $CHAR(7)
QUIT
+10 SET DIR(0)="58.3511,10"
SET DIR("A")="CREDIT STATUS"
+11 SET OISTA=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,10,"I")
+12 SET DIR("B")=$SELECT(OISTA="":"P",1:OISTA)
+13 DO ^DIR
IF $DATA(DIRUT)
Begin DoDot:1
+14 SET VALMSG="Credit Update aborted"
SET VALMBCK="R"
DO UNLK(PSANODE)
End DoDot:1
QUIT
+15 SET PSAISTA=Y
SET (PSAIAMT,CREAMT)=""
SET CRESTA=$$EXTERNAL^DILFD(58.3511,10,,Y)
+16 KILL DIR,X,Y,DA
WRITE !
+17 ;Only ask for amount when status is Actual or Estimated
+18 IF ("^A^E^")[("^"_PSAISTA_"^")
Begin DoDot:1
+19 ;,DIR(0)="58.3511,"_FLDD
SET FLDD=$SELECT(PSAISTA="A":12,1:11)
+20 SET DIR(0)="NA^0.01:999999999:2"
SET DIR("?")="Type a Dollar amount between 0 and 999999999, 2 Decimal Digits"
+21 SET CREAMT=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,FLDD,"I")
+22 IF CREAMT'=""
SET DIR("B")=$JUSTIFY(CREAMT,0,2)
+23 SET DIR("A")=$$EXTERNAL^DILFD(58.3511,10,,PSAISTA)_" CREDIT AMOUNT: "
+24 DO ^DIR
+25 SET PSAIAMT=Y
End DoDot:1
+26 IF $DATA(DIRUT)
Begin DoDot:1
+27 SET VALMSG="Credit Update aborted"
SET VALMBCK="R"
WRITE $CHAR(7)
DO UNLK(PSANODE)
End DoDot:1
QUIT
+28 KILL DIR,X,Y,DA
WRITE !
+29 SET DIR(0)="Y"
SET DIR("A")=" Save Credit"
SET DIR("B")="N"
+30 DO ^DIR
IF $DATA(DIRUT)!('Y)
Begin DoDot:1
+31 SET VALMSG="Credit Update aborted..."
SET VALMBCK="R"
WRITE $CHAR(7)
DO UNLK(PSANODE)
End DoDot:1
QUIT
+32 ; if record unchanged, quit.
+33 IF OISTA=PSAISTA
IF CREAMT=PSAIAMT
SET VALMBCK="R"
QUIT
+34 IF OISTA'=PSAISTA
Begin DoDot:1
+35 SET PSACOM="CREDIT STATUS changed from "_$SELECT(OISTA="":"''",1:$$EXTERNAL^DILFD(58.3511,10,,OISTA))_" to "_$$EXTERNAL^DILFD(58.3511,10,,PSAISTA)_". "
+36 DO LOGACT^PSARDCUT(PSAPHLOC,PSABATCH,PSAITEM,"E",PSACOM)
End DoDot:1
+37 IF ("^A^E^")[("^"_PSAISTA_"^")
Begin DoDot:1
+38 SET PSACOM=$$EXTERNAL^DILFD(58.3511,10,,PSAISTA)_" CREDIT AMOUNT changed from "_$SELECT(CREAMT="":"''",1:"$"_$JUSTIFY(CREAMT,0,2))_" to $"_$JUSTIFY(PSAIAMT,0,2)_"."
+39 DO LOGACT^PSARDCUT(PSAPHLOC,PSABATCH,PSAITEM,"E",PSACOM)
End DoDot:1
+40 IF ("^P^D^")[("^"_PSAISTA_"^")
Begin DoDot:1
+41 SET PSACOM=""
+42 SET ESTAMT=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,11,"I")
+43 IF ESTAMT'=""
SET PSACOM="ESTIMATED CREDIT AMOUNT of $"_$JUSTIFY(ESTAMT,0,2)
+44 SET ACTAMT=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,12,"I")
+45 IF ACTAMT'=""
SET PSACOM=PSACOM_$SELECT(PSACOM="":"",1:" and ")_"ACTUAL CREDIT AMOUNT of $"_$JUSTIFY(ACTAMT,0,2)
+46 IF PSACOM'=""
SET PSACOM=PSACOM_$SELECT(PSACOM["and":" were",1:" was")_" automatically deleted."
+47 IF PSACOM'=""
DO LOGACT^PSARDCUT(PSAPHLOC,PSABATCH,PSAITEM,"E",PSACOM)
End DoDot:1
+48 DO ITMUPD
DO UNLK(PSANODE)
DO HDR
DO SETLINE
+49 SET VALMBCK="R"
+50 QUIT
+51 ;
ITMUPD ; - Single Item File Update
+1 NEW PSAIENS,PSARY
+2 SET DA(2)=PSAPHLOC
SET DA(1)=PSABATCH
SET DA=PSAITEM
+3 SET PSAIENS=$$IENS^DILF(.DA)
+4 SET PSARY(58.3511,PSAIENS,10)=PSAISTA
+5 IF ("^A^E^")[("^"_PSAISTA_"^")
SET PSARY(58.3511,PSAIENS,FLDD)=PSAIAMT
+6 IF ("^P^D^")[("^"_PSAISTA_"^")
Begin DoDot:1
+7 SET PSARY(58.3511,PSAIENS,11)=""
+8 SET PSARY(58.3511,PSAIENS,12)=""
End DoDot:1
+9 DO UPDATE^DIE("","PSARY")
+10 QUIT
+11 ;
BATSTA(PSAPHLOC,PSABATCH) ; - Returns if a batch is editable
+1 ; Input: PSAPHLOC - Pharmacy location
+2 ; PSABATCH - Batch IEN from ^PSD(58.35,
+3 ; Output: 1^Batch Status
+4 ; 0^Error message
+5 NEW BATST,MSG
+6 SET BATST=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1,"I")
+7 IF "^CO^CA^"[BATST
Begin DoDot:1
+8 SET MSG="Cannot change. This batch has been "_$SELECT(BATST="CO":"completed.",1:"cancelled.")
End DoDot:1
QUIT 0_"^"_MSG
+9 QUIT 1_"^"_BATST
+10 ;
LK(NODE) ;- Locks node
+1 LOCK +@NODE:$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
QUIT $TEST
+2 ;
UNLK(NODE) ;Unlocks node
+1 LOCK -@NODE
+2 QUIT
EXIT ;
+1 KILL ^TMP("PSARDCIT",$JOB)
+2 QUIT
+3 ;
HELP ;
+1 QUIT
