Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSARDCBA

PSARDCBA.m

Go to the documentation of this file.
  1. PSARDCBA ;BIRM/MFR - Return Drug Batch - ListMan ;07/01/08
  1. ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**69,72**;10/24/97;Build 2
  1. ;References to DRUG file (#50) supported by IA #2095
  1. ;References to ORDER UNIT file (#51.5) supported by IA #1931
  1. ;
  1. SB ; - Single Batch View/Process
  1. N PSAPHLOC,PSABATCH,DIC,Y,X,DA
  1. ;
  1. ; - Checking for security keys (PSARET, PSAMGR or PSORPH)
  1. I '$$CHKEY^PSARDCUT() Q
  1. ;
  1. ; - Pharmacy location selection
  1. S PSAPHLOC=+$$PHLOC^PSARDCUT() I 'PSAPHLOC Q
  1. ;
  1. ; - Batch selection
  1. K DIC,Y,X,DA,DTOUT,DUOUT
  1. S DIC="^PSD(58.35,"_PSAPHLOC_",""BAT"",",DIC(0)="AQEM",DIC("A")="Select BATCH NUMBER: "
  1. W ! D ^DIC I X=""!$D(DTOUT)!$D(DUOUT) Q
  1. S PSABATCH=+Y
  1. ;
  1. D EN(PSAPHLOC,PSABATCH)
  1. Q
  1. ;
  1. EN(PSAPHLOC,PSABATCH) ; - ListManager entry point
  1. N PSACTMF,PSACTMFN,PSAREF,PSAQUIT
  1. ;
  1. D LOAD()
  1. W !,"Please wait..."
  1. D EN^VALM("PSA RETURN DRUG BATCH")
  1. D FULL^VALM1
  1. G EXIT
  1. ;
  1. HDR ; - Header
  1. D LMHDR^PSARDCUT(PSAPHLOC,PSABATCH)
  1. D SETHDR()
  1. Q
  1. ;
  1. SETHDR() ; - Displays the Header Line
  1. N HDR
  1. ;
  1. ; - Line 1
  1. S $E(HDR,48)="ORD",$E(HDR,52)="ORDER",$E(HDR,61)="DISP",$E(HDR,66)="DISP"
  1. S $E(HDR,72)="ACTUAL",$E(HDR,81)="" D INSTR^VALM1(IORVON_HDR_IOINORM,1,6)
  1. ; - Line 2
  1. S HDR=" #",$E(HDR,5)="RETURN DRUG (NDC)",$E(HDR,48)="QTY",$E(HDR,52)="UNIT"
  1. S $E(HDR,62)="QTY",$E(HDR,66)="UNIT",$E(HDR,72)="CREDIT($)"
  1. S $E(HDR,81)="" D INSTR^VALM1(IORVON_HDR_IOINORM,1,7)
  1. Q
  1. ;
  1. INIT ; - Populates the Body section for ListMan
  1. K ^TMP("PSARDCSR",$J),^TMP("PSARDCBA",$J)
  1. ;
  1. S VALMCNT=0
  1. D SORT,SETLINE
  1. S VALMSG="Select the entry # to view or ?? for more actions"
  1. Q
  1. ;
  1. SORT ; - Sets the line to be displayed in ListMan
  1. N ITEM,DRUGNAM
  1. ;
  1. S (ITEM,SEQ)=0
  1. F S ITEM=$O(^PSD(58.35,PSAPHLOC,"BAT",PSABATCH,"ITM",ITEM)) Q:'ITEM D
  1. . S DRUGNAM=$$GET1^DIQ(58.3511,ITEM_","_PSABATCH_","_PSAPHLOC,.01) I DRUGNAM="" Q
  1. . S ^TMP("PSARDCSR",$J,DRUGNAM,ITEM)=""
  1. Q
  1. ;
  1. SETLINE ; - Sets the line to be displayed in ListMan
  1. N DRUGNAM,ITEM,LINE,SEQ,DATA,FLDS,DRUG,NDC,QTY,ORDUNT,DUQTY,DSPUNT,ACTCRD
  1. ;
  1. S DRUGNAM="",(ITEM,SEQ)=0
  1. F S DRUGNAM=$O(^TMP("PSARDCSR",$J,DRUGNAM)) Q:DRUGNAM="" D
  1. . F S ITEM=$O(^TMP("PSARDCSR",$J,DRUGNAM,ITEM)) Q:'ITEM D
  1. . . S SEQ=SEQ+1
  1. . . D GETS^DIQ(58.3511,ITEM_","_PSABATCH_","_PSAPHLOC_",","*","IE","FLDS")
  1. . . K DATA M DATA=FLDS(58.3511,ITEM_","_PSABATCH_","_PSAPHLOC_",")
  1. . . S DRUG=$E(DATA(.01,"E"),1,25),NDC=DATA(3,"E"),QTY=DATA(6,"E")
  1. . . S ORDUNT=DATA(5,"I") I ORDUNT S ORDUNT=$E($$GET1^DIQ(51.5,ORDUNT,.02),1,6)
  1. . . S DUQTY=DATA(17,"E"),DSPUNT=$E(DATA(8,"E"),1,6),ACTCRD=DATA(12,"I")
  1. . . ; - Display Line
  1. . . S LINE=$J(SEQ,3),$E(LINE,5)=DRUG_" ("_NDC_")",$E(LINE,46)=$J(QTY,5),$E(LINE,52)=ORDUNT
  1. . . S $E(LINE,59)=$J(DUQTY,6),$E(LINE,66)=DSPUNT,$E(LINE,72)=$J(ACTCRD,9,2)
  1. . . S ^TMP("PSARDCBA",$J,SEQ,0)=LINE,VALMCNT=VALMCNT+1
  1. . . S ^TMP("PSARDCBA",$J,SEQ,"ITEM")=ITEM
  1. . . S ^TMP("PSARDCBA",$J,SEQ,"DISP")=DRUG_" ("_NDC_") - Quantity: "_QTY_" ("_ORDUNT_")"
  1. ;
  1. I '$D(^TMP("PSARDCBA",$J)) D
  1. . S ^TMP("PSARDCBA",$J,6,0)=" This batch contains no return items."
  1. . S VALMCNT=0
  1. Q
  1. ;
  1. ADD ; - Add New Item action
  1. N PSAMORE,I,DIR,Y,PSAQUIT
  1. I '$$LKBAT(PSAPHLOC,PSABATCH) D Q
  1. . S VALMSG="This batch is being edited by another user!",VALMBCK="R"
  1. ;
  1. I $$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1,"I")'="AP" D Q
  1. . S VALMSG="Only AWAITING PICKUP batches can have items added!",VALMBCK="R" W $C(7)
  1. . D UNLKBAT(PSAPHLOC,PSABATCH)
  1. ;
  1. D FULL^VALM1 W !
  1. S PSAMORE=1,PSAQUIT=0,DIR("A")="Add another Item? ",DIR(0)="YA",DIR("B")="YES"
  1. F I=1:1 Q:'PSAMORE!PSAQUIT D
  1. . D ITEM^PSARDCU1(PSAPHLOC,PSABATCH,,.PSAQUIT) Q:PSAQUIT
  1. . W ! D ^DIR S PSAMORE=+$G(Y) W !
  1. ;
  1. D INIT,UNLKBAT(PSAPHLOC,PSABATCH)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. CAN ; - Cancel Batch action
  1. N DIR,DIRUT,DIROUT,ITEM,QTY,DRUG,PSACOMM
  1. ;
  1. I '$$LKBAT(PSAPHLOC,PSABATCH) D Q
  1. . S VALMSG="This batch is being edited by another user!",VALMBCK="R"
  1. ;
  1. I $$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1,"I")="CA" D Q
  1. . S VALMSG="Batch is already CANCELLED!",VALMBCK="R" W $C(7)
  1. . D UNLKBAT(PSAPHLOC,PSABATCH)
  1. ;
  1. I $$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1,"I")="CO"!($$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1,"I")="PU") D Q
  1. . S VALMSG=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1)_" batches cannot be cancelled!",VALMBCK="R" W $C(7)
  1. . D UNLKBAT(PSAPHLOC,PSABATCH)
  1. ;
  1. D FULL^VALM1
  1. W ! S DIR(0)="FA^3:84",DIR("A")="COMMENTS: "
  1. D ^DIR I $D(DIRUT)!$D(DIROUT) S VALMBCK="R" D UNLKBAT(PSAPHLOC,PSABATCH) Q
  1. S PSACOMM=X
  1. ;
  1. ; - Confirm?
  1. W ! S DIR(0)="YA",DIR("B")="NO",DIR("A")="Cancel Batch? "
  1. D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y=0) S VALMBCK="R" D UNLKBAT(PSAPHLOC,PSABATCH) Q
  1. ;
  1. W !!,"Cancelling Batch..."
  1. S DA(1)=PSAPHLOC,DA=PSABATCH
  1. S DIE="^PSD(58.35,"_PSAPHLOC_",""BAT"","
  1. S DR="1///CA;6///"_$$NOW^XLFDT()_";7////"_DUZ_";8///^S X=PSACOMM"
  1. D ^DIE
  1. W "OK"
  1. ; - Cancel Comments / Update Drug Inventory
  1. S ITEM=0
  1. F S ITEM=$O(^PSD(58.35,PSAPHLOC,"BAT",PSABATCH,"ITM",ITEM)) Q:'ITEM D
  1. . D LOGACT^PSARDCUT(PSAPHLOC,PSABATCH,ITEM,"C","BATCH CANCELLED: "_PSACOMM)
  1. . I $$GET1^DIQ(58.3511,ITEM_","_PSABATCH_","_PSAPHLOC,14,"I") D
  1. . . S DRUG=$$GET1^DIQ(58.3511,ITEM_","_PSABATCH_","_PSAPHLOC,.01,"I")
  1. . . S QTY=+$$GET1^DIQ(58.3511,ITEM_","_PSABATCH_","_PSAPHLOC,17,"I")
  1. . . D UPDINV^PSARDCUT(PSAPHLOC,PSABATCH,ITEM,DRUG,QTY,1)
  1. D UNLKBAT(PSAPHLOC,PSABATCH) H 1
  1. Q
  1. ;
  1. PKP ; - Pickup Batch action
  1. N DIR,DA,X,Y
  1. ;
  1. I '$O(^PSD(58.35,PSAPHLOC,"BAT",PSABATCH,"ITM",0)) D Q
  1. . S VALMSG="There are no items to be picked up in this batch!",VALMBCK="R" W $C(7)
  1. . D UNLKBAT(PSAPHLOC,PSABATCH)
  1. ;
  1. I $$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1,"I")'="AP" D Q
  1. . S VALMSG="Only AWAITING PICKUP batches can be picked up!",VALMBCK="R" W $C(7)
  1. . D UNLKBAT(PSAPHLOC,PSABATCH)
  1. ;
  1. I '$$LKBAT(PSAPHLOC,PSABATCH) D Q
  1. . S VALMSG="This batch is being edited by another user!",VALMBCK="R"
  1. . D UNLKBAT(PSAPHLOC,PSABATCH)
  1. ;
  1. D FULL^VALM1
  1. D EDIT I $G(PSAQUIT) D UNLKBAT(PSAPHLOC,PSABATCH) Q
  1. ;
  1. W ! S DIR(0)="YA",DIR("B")="NO",DIR("A")=" Pick up Batch? "
  1. D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y=0) S VALMBCK="R" D UNLKBAT(PSAPHLOC,PSABATCH) Q
  1. ;
  1. S DIE="^PSD(58.35,"_PSAPHLOC_",""BAT"",",DA(1)=PSAPHLOC,DA=PSABATCH
  1. S DR="1////PU"_";2///^S X=$$NOW^XLFDT();4////^S X=PSACTMF;5////^S X=PSAREF"
  1. ;
  1. D ^DIE
  1. ;
  1. W ! S DIR(0)="YA",DIR("B")="YES",DIR("A")="Do you want to update credit for items? "
  1. D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y=0) S VALMBCK="R" D HDR,UNLKBAT(PSAPHLOC,PSABATCH) Q
  1. ;
  1. D CRE,UNLKBAT(PSAPHLOC,PSABATCH)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. CRE ; - Update Credit action
  1. N TYPE,SEQS,ITEM,DIR,DIE,DR,DA,I,X,Y,DIRUT,DIROUT,OLDSTS,OLDACT,OLDEST,ITEMIEN
  1. ;
  1. I $$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1,"I")'="PU" D Q
  1. . S VALMSG="Batch status must be PICKED UP to update credit!",VALMBCK="R" W $C(7)
  1. . D UNLKBAT(PSAPHLOC,PSABATCH)
  1. ;
  1. I '$$LKBAT(PSAPHLOC,PSABATCH) D Q
  1. . S VALMSG="This batch is being edited by another user!",VALMBCK="R"
  1. ;
  1. D FULL^VALM1
  1. K DIR,DIRUT,DIROUT,X,Y
  1. S DIR(0)="S^E:ESTIMATED;A:ACTUAL;B:BOTH",DIR("A")="CREDIT TYPE",DIR("B")="A"
  1. D ^DIR I $D(DIRUT)!$D(DIROUT) S VALMBCK="R" D UNLKBAT(PSAPHLOC,PSABATCH) Q
  1. S TYPE=Y
  1. ;
  1. K DIR,Y,X,DIRUT,DIROUT
  1. S DIR(0)="L^1:"_VALMCNT,DIR("A")="ITEM(S)"
  1. S DIR("?",1)="Enter one, multiple or an interval of item(s)"
  1. S DIR("?",2)="(e.g., '1-3' for items 1, 2 and 3; '1,4,6' for"
  1. S DIR("?",3)=" items 1, 4 and 6)"
  1. S DIR("?",4)=""
  1. S DIR("?")="Enter ?? to see the complete list of items."
  1. S DIR("??")="^D LIST^PSARDCUT("_PSAPHLOC_","_PSABATCH_")"
  1. W ! D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y'>0) S VALMBCK="R" D UNLKBAT(PSAPHLOC,PSABATCH) Q
  1. S SEQS=Y
  1. ;
  1. K DA,DR
  1. S DIE="^PSD(58.35,"_PSAPHLOC_",""BAT"","_PSABATCH_",""ITM"","
  1. S DA(2)=PSAPHLOC,DA(1)=PSABATCH
  1. F I=1:1:$L(SEQS,",") S ITEM=$P(SEQS,",",I) Q:'ITEM D
  1. . S (ITEMIEN,DA)=+^TMP("PSARDCBA",$J,ITEM,"ITEM")
  1. . S OLDEST=$$GET1^DIQ(58.3511,DA_","_DA(1)_","_DA(2),11,"I")
  1. . S OLDACT=$$GET1^DIQ(58.3511,DA_","_DA(1)_","_DA(2),12,"I")
  1. . W !!,"Item ",ITEM,": ",^TMP("PSARDCBA",$J,ITEM,"DISP")
  1. . S DR=$S(TYPE="E":11,TYPE="A":12,1:"11;12")
  1. . W ! D ^DIE S DR=""
  1. . I +OLDEST'=+$$GET1^DIQ(58.3511,DA_","_DA(1)_","_DA(2),11,"I") D
  1. . . D LOGACT(11,$$AMT(OLDEST),$$AMT($$GET1^DIQ(58.3511,DA_","_DA(1)_","_DA(2),11,"I")),ITEMIEN)
  1. . I +OLDACT'=+$$GET1^DIQ(58.3511,DA_","_DA(1)_","_DA(2),12,"I") D
  1. . . D LOGACT(12,$$AMT(OLDACT),$$AMT($$GET1^DIQ(58.3511,DA_","_DA(1)_","_DA(2),12,"I")),ITEMIEN)
  1. . S OLDSTS=$$GET1^DIQ(58.3511,DA_","_DA(1)_","_DA(2),10)
  1. . I $$GET1^DIQ(58.3511,DA_","_DA(1)_","_DA(2),12) D
  1. . . S DR="10////A" I OLDSTS'="ACTUAL" D LOGACT(10,OLDSTS,"ACTUAL",ITEMIEN)
  1. . E I $$GET1^DIQ(58.3511,DA_","_DA(1)_","_DA(2),11) D
  1. . . S DR="10////E" I OLDSTS'="ESTIMATED" D LOGACT(10,OLDSTS,"ESTIMATED",ITEMIEN)
  1. . I '$$GET1^DIQ(58.3511,DA_","_DA(1)_","_DA(2),12),'$$GET1^DIQ(58.3511,DA_","_DA(1)_","_DA(2),11) D
  1. . . I $$GET1^DIQ(58.3511,DA_","_DA(1)_","_DA(2),10,"I")'="D",OLDSTS'="PENDING" D
  1. . . . S DR="10////P" D LOGACT(10,OLDSTS,"PENDING",ITEMIEN)
  1. . D ^DIE
  1. ;
  1. D HDR,INIT,UNLKBAT(PSAPHLOC,PSABATCH)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. EDT ; - Edit Batch action
  1. N DIE,DR,DA,X,Y,DIR,DIRUT,DIROUT
  1. ;
  1. I '$$LKBAT(PSAPHLOC,PSABATCH) D Q
  1. . S VALMSG="This batch is being edited by another user!",VALMBCK="R"
  1. ;
  1. I $$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1,"I")="CO"!($$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1,"I")="CA") D Q
  1. . S VALMSG=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1)_" batches cannot be edited!",VALMBCK="R" W $C(7)
  1. . D UNLKBAT(PSAPHLOC,PSABATCH)
  1. ;
  1. S PSACTMF=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,4,"I")
  1. S PSACTMFN=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,4,"E")
  1. S PSAREF=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,5,"I")
  1. ;
  1. D FULL^VALM1
  1. D EDIT I $G(PSAQUIT) D UNLKBAT(PSAPHLOC,PSABATCH) Q
  1. ;
  1. W ! S DIR(0)="YA",DIR("B")="YES",DIR("A")="Save Batch? "
  1. D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y=0) S VALMBCK="R" D UNLKBAT(PSAPHLOC,PSABATCH) Q
  1. ;
  1. W !!,"Saving Batch..."
  1. S DIE="^PSD(58.35,"_PSAPHLOC_",""BAT"",",DA(1)=PSAPHLOC,DA=PSABATCH
  1. S DR="4////^S X=PSACTMF;5////^S X=$S(PSAREF="""":""@"",1:PSAREF)"
  1. ;
  1. D ^DIE
  1. W "OK"
  1. D HDR,UNLKBAT(PSAPHLOC,PSABATCH)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. EDIT ; - Edit Batch action
  1. N DIE,DIC,DIR,DR,DA,X,Y
  1. ;
  1. S PSAQUIT=0 D FULL^VALM1 W !
  1. K DIC,Y,X
  1. S DIC="^PSD(58.36,",DIC(0)="QEAM",DIC("A")=" RETURN CONTRACTOR: "
  1. S DIC("S")="I $S($P($G(^(0)),""^"",2):$P($G(^(0)),""^"",2)>DT,1:1)!(Y=$G(PSACTMF))"
  1. I $G(PSACTMFN)'="" S DIC("B")=PSACTMFN
  1. I $G(DIC("B"))="" S DIC("B")=$P($$DEFCTMF^PSARDCUT(),"^",2) K:DIC("B")="" DIC("B")
  1. D ^DIC I X=""!$D(DTOUT)!$D(DUOUT) S VALMBCK="R" S PSAQUIT=1 Q
  1. S PSACTMF=+Y,PSACTMFN=$P(Y,"^",2)
  1. ;
  1. K DIR,DIRUT,DIROUT
  1. I $G(PSAREF)'="" S DIR("B")=PSAREF K:DIR("B")="" DIR("B")
  1. S DIR(0)="FAO^1:20",DIR("A")="RETURN CONTRACTOR REF#: "
  1. S DIR("?")="Enter the pickup reference number from this contractor/manufacturer for the batch."
  1. D ^DIR I X="@" S PSAREF="",VALMBCK="R" Q
  1. I X'="",$D(DIRUT)!$D(DIROUT) S VALMBCK="R" S PSAQUIT=1 Q
  1. S PSAREF=X
  1. ;
  1. Q
  1. ;
  1. LKBAT(PHLOC,BATCH) ; - Locks the batch
  1. L +^PSD(58.35,PHLOC,"BAT",BATCH):+$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
  1. Q ($T)
  1. ;
  1. UNLKBAT(PHLOC,BATCH) ; - Unlocks the batch
  1. L -^PSD(58.35,PHLOC,"BAT",BATCH)
  1. Q
  1. ;
  1. COM ; - Complete Batch action
  1. N DIE,DA,DR,DIR,DIRUT,DIROUT,X,Y,ITM,Z
  1. ;
  1. I '$$LKBAT(PSAPHLOC,PSABATCH) D Q
  1. . S VALMSG="This batch is being edited by another user!",VALMBCK="R"
  1. ;
  1. I $$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1,"I")="CO" D Q
  1. . S VALMSG="Batch has already been completed!",VALMBCK="R" W $C(7)
  1. . D UNLKBAT(PSAPHLOC,PSABATCH)
  1. ;
  1. I $$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1,"I")'="PU" D Q
  1. . S VALMSG="Only PICKED UP batches can be completed!",VALMBCK="R" W $C(7)
  1. . D UNLKBAT(PSAPHLOC,PSABATCH)
  1. ;
  1. D FULL^VALM1,CHKCRE(PSAPHLOC,PSABATCH)
  1. ;
  1. ; - Confirm
  1. W ! S DIR(0)="YA",DIR("B")="NO",DIR("A")="Complete Batch? "
  1. D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y=0) S VALMBCK="R" D UNLKBAT(PSAPHLOC,PSABATCH) Q
  1. ;
  1. W !!,"Completing Batch..."
  1. S DA(1)=PSAPHLOC,DA=PSABATCH
  1. S DIE="^PSD(58.35,"_PSAPHLOC_",""BAT"","
  1. S DR="1///CO;9///"_$$NOW^XLFDT()_";10////"_DUZ
  1. D ^DIE
  1. ;
  1. K DIE,DA,DR
  1. S DA(2)=PSAPHLOC,DA(1)=PSABATCH
  1. S ITM=0
  1. F S ITM=$O(^PSD(58.35,PSAPHLOC,"BAT",PSABATCH,"ITM",ITM)) Q:'ITM D
  1. . S Z=^PSD(58.35,PSAPHLOC,"BAT",PSABATCH,"ITM",ITM,0)
  1. . I '$P(Z,"^",13),$P(Z,"^",11)'="D" D
  1. . . D LOGACT(10,$$GET1^DIQ(58.3511,ITM_","_PSABATCH_","_PSAPHLOC,10),"DENIED",ITM)
  1. . . S DIE="^PSD(58.35,"_PSAPHLOC_",""BAT"","_PSABATCH_",""ITM"","
  1. . . S DA=ITM,DR="10////D" D ^DIE
  1. ;
  1. W "OK"
  1. ;
  1. D UNLKBAT(PSAPHLOC,PSABATCH) H 1
  1. Q
  1. ;
  1. SEL ; - Select Item action
  1. N PSASEL,ITEM
  1. ;
  1. S PSASEL=+$P($P($G(Y(1)),"^",4),"=",2)
  1. I $G(PSASEL),'$G(^TMP("PSARDCBA",$J,PSASEL,"ITEM")) D Q
  1. . S VALMSG="Invalid selection!",VALMBCK="R" W $C(7)
  1. ;
  1. I '$O(^PSD(58.35,PSAPHLOC,"BAT",PSABATCH,"ITM",0)) D Q
  1. . S VALMSG="There are no items to be selected in this batch!",VALMBCK="R" W $C(7)
  1. ;
  1. I '$G(^TMP("PSARDCBA",$J,PSASEL,"ITEM")) D I 'PSASEL S VALMBCK="R" Q
  1. . D FULL^VALM1
  1. . N DIR,Y,X,DIRUT,DIROUT
  1. . S DIR(0)="N^1:"_VALMCNT,DIR("A")="SELECT ITEM"
  1. . S DIR("?",1)="Enter the item number to be selected."
  1. . S DIR("?",2)=""
  1. . S DIR("?")="Enter ?? to see the complete list of items."
  1. . S DIR("??")="^D LIST^PSARDCUT("_PSAPHLOC_","_PSABATCH_")"
  1. . W ! D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y'>0) S VALMBCK="R" Q
  1. . S PSASEL=+Y
  1. ;
  1. S ITEM=+^TMP("PSARDCBA",$J,PSASEL,"ITEM")
  1. D ;
  1. . N XQORM
  1. . D EN^PSARDCIT(PSAPHLOC,PSABATCH,ITEM),INIT
  1. ;
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. EXIT ;
  1. K ^TMP("PSARDCSR",$J),^TMP("PSARDCBA",$J)
  1. Q
  1. ;
  1. HELP Q
  1. ;
  1. LOAD() ; - Load Batch information
  1. N FLDS,DATA
  1. S (PSACTMF,PSACTMFN,PSAREF)=""
  1. ;
  1. K FLDS D GETS^DIQ(58.351,PSABATCH_","_PSAPHLOC_",","4;5","IE","FLDS")
  1. K DATA M DATA=FLDS(58.351,PSABATCH_","_PSAPHLOC_",")
  1. S PSACTMF=DATA(4,"I"),PSACTMFN=DATA(4,"E"),PSAREF=$G(DATA(5,"I"))
  1. Q
  1. ;
  1. CHKCRE(PHLOC,BATCH) ; - Check if Actual Credit have been entered
  1. N ITM,DSPLN,NOCRED,XX,DIR,Y,X,DIRUT,Z,DRNAM,CNT
  1. S ITM=0
  1. F S ITM=$O(^PSD(58.35,PHLOC,"BAT",BATCH,"ITM",ITM)) Q:'ITM D
  1. . S Z=^PSD(58.35,PHLOC,"BAT",BATCH,"ITM",ITM,0)
  1. . I '$P(Z,"^",13),$P(Z,"^",11)'="D" D
  1. . . S DSPLN=$E($E($$GET1^DIQ(50,+Z,.01),1,24)_" ("_$P(Z,"^",4)_")",1,40)
  1. . . S $E(DSPLN,41)=$J($P(Z,"^",18),8),$E(DSPLN,50)=$P(Z,"^",9)
  1. . . S NOCRED($$GET1^DIQ(50,+Z,.01),ITM)=DSPLN
  1. ;
  1. I $D(NOCRED) D
  1. . W !!,"WARNING: The following items will have their CREDIT STATUS"
  1. . W !?9,"set to DENIED because no credit amount has been"
  1. . W !?9,"entered for them:",! S $P(XX,"-",60)=""
  1. . W !?9,XX,!?9,"RETURN DRUG (NDC)",?49,"DISP QTY",?58,"UNIT",!?9,XX,!
  1. . S CNT=0,DRNAM="" F S DRNAM=$O(NOCRED(DRNAM)) Q:DRNAM="" D I $G(DIRUT) Q
  1. . . S ITM=0 F S ITM=$O(NOCRED(DRNAM,ITM)) Q:'ITM D I $G(DIRUT) Q
  1. . . . S CNT=CNT+1 W ?9,NOCRED(DRNAM,ITM) I '(CNT#15) S DIR(0)="E" D ^DIR W $C(13) Q
  1. . . . W !
  1. ;
  1. Q
  1. LOGACT(FIELD,OLDVALUE,NEWVALUE,ITEM) ; - Log an activity for the return item
  1. N COMM
  1. S COMM=$$GET1^DID(58.3511,FIELD,"","LABEL")_" "
  1. S COMM=COMM_$S(FIELD=10:"automatically ",1:"")_"changed from "_$S(OLDVALUE="":"''",1:OLDVALUE)_" to "_$S(NEWVALUE="":"''",1:NEWVALUE)_"."
  1. D LOGACT^PSARDCUT(PSAPHLOC,PSABATCH,ITEM,"E",COMM)
  1. Q
  1. ;
  1. AMT(VAL) ; Returns the amount formatted
  1. I $G(VAL) Q $J(VAL,0,2)
  1. Q $G(VAL)