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

PSARDCU1.m

Go to the documentation of this file. 
  1. PSARDCU1 ;BIRM/MFR - Return Drug - Utilities (Cont.) ;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. ITEM(PHARMLOC,BATCH,ITEM,QUIT) ; - Add/Edit Item
  1.  N FIELDS,PSAMFR,PSANDC,PSAUPC,PSAORDUN,PSAQTYOU,PSAQTYDU,PSADUOU,PSADSPUN
  1.  N PSADUNAM,PSAESTCR,PSAACTCR,PSACOST,PSAUPINV,PSAREAS,PSAEXPDT,PSADRNAM
  1.  N PSADRUG,PSAUSER,DATA,OLDDATA,NEWDATA,PSAOUNAM,PRPT,EXPDT,DIC,DIR,Y,X
  1.  ;
  1.  D LOAD()
  1.  ;
  1. DRUG ; - Drug
  1.  K DIC,Y,X
  1.  S DIC="^PSDRUG(",DIC(0)="QEAM",DIC("A")="DRUG: "
  1.  S DIC("B")=$G(PSADRNAM) K:DIC("B")="" DIC("B")
  1.  D ^DIC I $D(DTOUT) G END
  1.  I X=""!('$G(PSADRUG)&(X["^"&(X'="^"))) D  G DRUG
  1.  . W !,"This is a required response. Enter '^' to exit"
  1.  I $D(DUOUT) G @$$GOTO(X,"DRUG")
  1.  S PSADRUG=+Y,PSADRNAM=$$GET1^DIQ(50,PSADRUG,.01)
  1.  I 'PSAORDUN S PSAORDUN=$$GET1^DIQ(50,PSADRUG,12,"I")
  1.  I PSAORDUN S PSAOUNAM=$$GET1^DIQ(51.5,PSAORDUN,.02)
  1.  I PSADSPUN="" S (PSADUNAM,PSADSPUN)=$$GET1^DIQ(50,PSADRUG,14.5)
  1.  I PSADUNAM="" S PSADUNAM="DISP. UNIT"
  1.  I PSADUOU="" S PSADUOU=+$$GET1^DIQ(50,PSADRUG,15)
  1.  ;
  1. MFR ; - Manufacturer
  1.  K DIR,DIRUT,DIROUT
  1.  S DIR(0)="FAO^3:30",DIR("A")="MFR: "
  1.  S DIR("B")=$G(PSAMFR) K:DIR("B")="" DIR("B")
  1.  S DIR("?")="Enter the drug manufacturer name."
  1.  D ^DIR I X'="",$D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"MFR")
  1.  I X="@" K DIR("B") S PSAMFR="" W "    Deleted!" G MFR
  1.  I X="" S PSAMFR="" G NDC
  1.  S PSAMFR=X
  1.  ;
  1. NDC ; - NDC
  1.  I $G(PSANDC)["^" S PSANDC=""
  1.  D NDCEDT^PSANDCUT(PSADRUG,.PSANDC)
  1.  I PSANDC["^" S X=PSANDC,PSANDC="" G @$$GOTO(X,"NDC")
  1.  ;
  1. ORDUNT ; - Order Unit
  1.  K DIC,Y,X
  1.  I $G(PSAORDUN)="" S PSAORDUN=$$GET1^DIQ(50,PSADRUG,12,"I")
  1.  I $G(PSAORDUN) S PSAOUNAM=$$GET1^DIQ(51.5,PSAORDUN,.02)
  1.  I $$GET1^DIQ(50,PSADRUG,12,"I")'="",$G(PSAOUNAM)'="" W !,"ORDER UNIT: ",PSAOUNAM G DSPUNT
  1.  S DIC="^DIC(51.5,",DIC(0)="QEAMZ",DIC("A")="ORDER UNIT: "
  1.  S DIC("B")=$G(PSAOUNAM) K:DIC("B")="" DIC("B")
  1.  D ^DIC I X'="",$D(DTOUT)!$D(DUOUT) G @$$GOTO(X,"ORDUNT")
  1.  I X="" W !,"This is a required response. Enter '^' to exit" G ORDUNT
  1.  I Y>0 S PSAORDUN=+Y,PSAOUNAM=$P(Y(0),"^",2)
  1.  ;
  1. DSPUNT ; - Dispense Unit
  1.  I $G(PSADSPUN)="" D
  1.  . S (PSADUNAM,PSADSPUN)=$$GET1^DIQ(50,PSADRUG,14.5) I PSADUNAM="" S PSADUNAM="DISPENSE UNIT"
  1.  I $$GET1^DIQ(50,PSADRUG,14.5)'="",$G(PSADSPUN)'="" W !,"DISPENSE UNIT: ",PSADSPUN G DUOU
  1.  K DIR,DIRUT,DIROUT
  1.  S DIR(0)="FAO^1:10",DIR("A")="DISPENSE UNIT: "
  1.  S DIR("B")=$G(PSADSPUN) K:DIR("B")="" DIR("B")
  1.  S DIR("?")="Enter the drug dispense unit."
  1.  D ^DIR I X="@" K DIR("B") S PSADSPUN="" W "    Deleted!" G DSPUNT
  1.  I X'="",$D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"DSPUNT")
  1.  I X="" S PSADSPUN="" G DUOU
  1.  I X?.N W "   ??",$C(7) G DSPUNT
  1.  S (PSADSPUN,PSADUNAM)=X
  1.  ;
  1. DUOU ; - Number of Dispense Units per Order Unit
  1.  I $G(PSADUOU)="" S PSADUOU=+$$GET1^DIQ(50,PSADRUG,15)
  1.  S:'PSADUOU PSADUOU=""
  1.  K DIR,Y,X,PRPT
  1.  S PRPT=$S($G(PSAOUNAM)'="":PSAOUNAM,1:"ORDER UNIT")
  1.  I $$GET1^DIQ(50,PSADRUG,15),$G(PSADUOU)'="" W !,"NUMBER OF "_PSADUNAM_"(S) PER "_PRPT_": ",PSADUOU G NUMOU
  1.  S DIR(0)="NA^0.01:999999999:2",DIR("A")="NUMBER OF "_PSADUNAM_"(S) PER "_PRPT_": "
  1.  S DIR("B")=$G(PSADUOU) K:'DIR("B") DIR("B")
  1.  S DIR("?")="Enter the number of "_PSADUNAM_"(S) per "_PRPT_" being returned with a maximum of 2 decimal digits."
  1.  D ^DIR I X'="",$D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"DUOU")
  1.  S PSADUOU=Y
  1.  ;
  1. NUMOU ; - Number of Order Units Returned
  1.  K DIR,Y,X,PRPT
  1.  S PRPT=$S($G(PSAOUNAM)'="":PSAOUNAM,1:"ORDER UNIT")
  1.  S DIR(0)="NAO^0.01:999999999:2",DIR("A")="NUMBER OF "_PRPT_"(S) TO RETURN: "
  1.  S DIR("B")=$G(PSAQTYOU) K:'DIR("B") DIR("B")
  1.  S DIR("?")="Enter the number of "_PRPT_"(S) being returned with a maximum of 2 decimal digits."
  1.  D ^DIR I X'="",$D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"NUMOU")
  1.  I X="" S PSAQTYOU=X G NUMDU
  1.  S PSAQTYOU=Y
  1.  ;
  1. NUMDU ; - Number of Dispense Units Returned
  1.  K DIR,Y,X,PRPT,DEFQTY
  1.  S DEFQTY=$G(PSAQTYOU)*$G(PSADUOU)\1
  1.  S PRPT=$S($G(PSADUNAM)'="":PSADUNAM,1:"DISPENSE UNIT")
  1.  I PSAQTYDU,(PSAQTYDU'=DEFQTY) W !!,"CURRENT DISPENSE QUANTITY ON FILE: ",PSAQTYDU," ",PRPT_"(S)",!
  1.  S DIR(0)="NA^1:999999999",DIR("A")="NUMBER OF "_PRPT_"(S) TO RETURN: "
  1.  S DIR("B")=$G(DEFQTY) K:'DIR("B") DIR("B")
  1.  S DIR("?")="Enter the number of "_PRPT_"(S) being returned."
  1.  D ^DIR I $D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"NUMOU")
  1.  S PSAQTYDU=Y
  1.  ;
  1. UPC ; - UPC
  1.  K DIR,Y,X
  1.  S DIR(0)="FAO^1:20",DIR("A")="UPC: "
  1.  S DIR("B")=$G(PSAUPC) K:DIR("B")="" DIR("B")
  1.  S DIR("?")="Enter the drug UPC."
  1.  D ^DIR I X="@" K DIR("B") S PSAUPC="" W "    Deleted!" G UPC
  1.  I X'="",$D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"UPC")
  1.  I X="" S PSAUPC="" G EXPDT
  1.  S PSAUPC=X
  1.  ;
  1. EXPDT ; - Expiration Date
  1.  K DIR,Y,X
  1.  N %DT,DTOUT,DUOUT
  1.  S DIR(0)="DAO^::AEST",DIR("A")="EXPIRATION DATE: "
  1.  S DIR("B")=$S($G(PSAEXPDT):$$UP^XLFSTR($$FMTE^XLFDT(PSAEXPDT)),1:"") K:DIR("B")="" DIR("B")
  1.  S DIR("?")="Enter the drug expiration date."
  1.  D ^DIR I X="@" K DIR("B") S PSAEXPDT="" W "    Deleted!" G EXPDT
  1.  I X'="",$D(DUOUT)!$D(DTOUT) G @$$GOTO(X,"EXPDT")
  1.  I X="" S PSAEXPDT="" G REASON
  1.  S PSAEXPDT=Y
  1.  ;
  1. REASON ; - Return Reason 
  1.  K DIR,DIRUT,DIROUT
  1.  S DIR(0)="58.3511,15",DIR("B")=$G(PSAREAS) K:DIR("B")="" DIR("B")
  1.  S DIR("A")="RETURN REASON" D ^DIR I X'="",$D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"REASON")
  1.  I X="" W !,"This is a required response. Enter '^' to exit" G REASON
  1.  S PSAREAS=Y
  1.  ;
  1. UPDINV ; - Update Inventory? 
  1.  K DIR,DIRUT,DIROUT,PSAUIEXT
  1.  S DIR(0)="SA^Y:YES;N:NO"
  1.  S PSAUIEXT="NO" I $G(PSAUPINV) S PSAUIEXT="YES"
  1.  S DIR("B")=$G(PSAUIEXT) K:DIR("B")="" DIR("B")
  1.  S DIR("A")="UPDATE INVENTORY: " D ^DIR I $D(DIRUT)!$D(DIROUT) G @$$GOTO(X,"UPDINV")
  1.  I Y="Y",'$D(^PSD(58.8,PHARMLOC,1,PSADRUG,0)) D  G UPDINV
  1.  . W !!?5,"Cannot update inventory. There is no inventory"
  1.  . W !?5,"information for this Drug/Pharmacy Location.",!,$C(7)
  1.  . S PSAUPINV=0
  1.  S PSAUPINV=$S(Y="Y":1,1:0)
  1.  ;
  1. CONF ; - Confirm?
  1.  W ! S DIR(0)="YA",DIR("B")="YES",DIR("A")="Save Item? "
  1.  D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y=0) G @$$GOTO(X,"CONF")
  1.  ;
  1.  I '$$CHKREQ() G @$$GOTO("^DRUG","CONF")
  1.  ;
  1.  D SAVE(),AUDIT()
  1.  ;
  1. END S QUIT=0 I $D(DTOUT)!$D(DIROUT)!$D(DIRUT)!$D(DUOUT) S QUIT=1
  1.  Q
  1.  ;
  1. GOTO(INPUT,HOME) ; - Directed up-arrow
  1.  N GOTO,TAG,TRGT
  1.  I $P(INPUT,"^",2)="" Q "END"
  1.  S INPUT=$$UP^XLFSTR(INPUT)
  1.  ;
  1.  S TRGT=$P(INPUT,"^",2)
  1.  S TAG("DRUG")="DRUG"
  1.  S TAG("MFR")="MFR"
  1.  S TAG("NDC")="NDC"
  1.  S TAG("ORDER UNIT")="ORDUNT"
  1.  S TAG("DISPENSE UNIT")="DSPUNT"
  1.  S TAG("NUMBER OF "_$G(PSAOUNAM))="NUMOU"
  1.  S TAG("NUMBER OF "_$G(PSADUNAM)_"(S) PER")="DUOU"
  1.  S TAG("NUMBER OF "_$G(PSADUNAM)_"(S) TO RETURN")="NUMDU"
  1.  S TAG("UPC")="UPC"
  1.  S TAG("EXPIRATION DATE")="EXPDT"
  1.  S TAG("RETURN REASON")="REASON"
  1.  S TAG("UPDATE INVENTORY")="UPDINV"
  1.  ;
  1.  S GOTO=HOME
  1.  S TAG="" F  S TAG=$O(TAG(TAG)) Q:TAG=""  I $E(TAG,1,$L(TRGT))=TRGT S GOTO=TAG(TAG) Q
  1.  I GOTO=HOME W "   ??",$C(7)
  1.  ;
  1.  Q GOTO
  1.  ;
  1. LOAD() ; - Load existing item information
  1.  S FIELDS=".01;1;2;3;4;5;6;7;8;9;14;15;17"
  1.  S (PSADRUG,PSAMFR,PSANDC,PSAUPC,PSAORDUN,PSAQTYOU,PSAQTYDU,PSADUOU,EXPDT)=""
  1.  S (PSADSPUN,PSAESTCR,PSAACTCR,PSACOST,PSAUPINV,PSAREAS,PSAUSER)=""
  1.  ;
  1.  I '$G(ITEM) Q
  1.  ;
  1.  K DATA D GETS^DIQ(58.3511,ITEM_","_BATCH_","_PHARMLOC_",",FIELDS,"IE","DATA")
  1.  K OLDDATA M OLDDATA=DATA(58.3511,ITEM_","_BATCH_","_PHARMLOC_",")
  1.  ;
  1.  S PSADRUG=OLDDATA(.01,"I"),PSADRNAM=OLDDATA(.01,"E"),PSAMFR=OLDDATA(2,"I")
  1.  S PSANDC=OLDDATA(3,"I"),PSAUPC=OLDDATA(4,"I"),PSAORDUN=$G(OLDDATA(5,"I"))
  1.  S PSAQTYOU=OLDDATA(6,"I"),PSADUOU=OLDDATA(7,"I"),PSADSPUN=OLDDATA(8,"I")
  1.  S PSAEXPDT=OLDDATA(9,"I"),PSAUPINV=OLDDATA(14,"I"),PSAREAS=OLDDATA(15,"I")
  1.  S PSAUSER=$G(OLDDATA(16,"I")),PSAQTYDU=OLDDATA(17,"I")
  1.  ;
  1.  I $G(PSAORDUN) S PSAOUNAM=$$GET1^DIQ(51.5,PSAORDUN,.02)
  1.  S PSADUNAM=PSADSPUN I PSADUNAM="" S PSADUNAM="DISP. UNIT"
  1.  Q
  1.  ;
  1. CHKREQ() ; - Checking for required fields
  1.  I '$G(PSAORDUN)!'$G(PSAQTYDU)!'$G(PSADUOU)!($G(PSAREAS)="") D  Q 0
  1.  . W !!?5,"The following required field(s) are missing:",$C(7),!
  1.  . W:'$G(PSAORDUN) !?10,"ORDER UNIT"
  1.  . W:'$G(PSADUOU) !?10,"NUMBER OF DISPENSE UNITS PER ORDER UNIT"
  1.  . W:'$G(PSAQTYDU) !?10,"NUMBER OF DISPENSE UNITS TO RETURN"
  1.  . W:$G(PSAREAS)="" !?10,"RETURN REASON"
  1.  . W !
  1.  Q 1
  1.  ;
  1. SAVE() ; - Saves Item
  1.  N DIE,DR,DA,NEWITEM
  1.  ;
  1.  W !!,"Saving..."
  1.  ;
  1.  S NEWITEM=0,DA(2)=PHARMLOC,DA(1)=BATCH
  1.  I '$G(ITEM) D
  1.  . N DIC,DR,X,DINUM,DLAYGO,DD,DO
  1.  . S DIC="^PSD(58.35,"_PHARMLOC_",""BAT"","_BATCH_",""ITM"",",X=PSADRUG,DIC(0)=""
  1.  . S DIC("DR")="1////"_$$NOW^XLFDT()_";10///P;16////"_DUZ
  1.  . K DD,DO D FILE^DICN K DD,DO
  1.  . S ITEM=+Y,NEWITEM=1
  1.  ;
  1.  S DR=".01////"_PSADRUG_";2///^S X=$S(PSAMFR'="""":PSAMFR,1:""@"");3///^S X=$S(PSANDC'="""":PSANDC,1:""@"")"
  1.  S DR=DR_";4///^S X=PSAUPC;5////^S X=PSAORDUN;6///^S X=PSAQTYOU;7///^S X=PSADUOU"
  1.  S DR=DR_";8///^S X=$S(PSADSPUN'="""":PSADSPUN,1:""@"");9///^S X=$S(PSAEXPDT'="""":PSAEXPDT,1:""@"")"
  1.  S DR=DR_";14///^S X=PSAUPINV;15///^S X=PSAREAS;17///^S X=PSAQTYDU"
  1.  ;
  1.  S DIE="^PSD(58.35,"_PHARMLOC_",""BAT"","_BATCH_",""ITM"",",DA=ITEM
  1.  D ^DIE W "OK" H 1
  1.  I NEWITEM,PSAUPINV D UPDINV^PSARDCUT(PHARMLOC,BATCH,ITEM,PSADRUG,-PSAQTYDU)
  1.  Q
  1.  ;
  1. AUDIT() ; - Activity Log/Inventory Update
  1.  I $D(OLDDATA) D
  1.  . N FLD K DATA D GETS^DIQ(58.3511,ITEM_","_BATCH_","_PHARMLOC_",",FIELDS,"IE","DATA")
  1.  . K NEWDATA M NEWDATA=DATA(58.3511,ITEM_","_BATCH_","_PHARMLOC_",")
  1.  . S FLD=""
  1.  . F  S FLD=$O(OLDDATA(FLD)) Q:FLD=""  D
  1.  . . I OLDDATA(FLD,"E")'=NEWDATA(FLD,"E") D
  1.  . . . D LOGACT(FLD,OLDDATA(FLD,"E"),NEWDATA(FLD,"E"),"E")
  1.  . . . ; DRUG changed
  1.  . . . I FLD=.01 D
  1.  . . . . I OLDDATA(14,"I") D UPDINV^PSARDCUT(PHARMLOC,BATCH,ITEM,OLDDATA(.01,"I"),OLDDATA(17,"I"))
  1.  . . . . I NEWDATA(14,"I") D UPDINV^PSARDCUT(PHARMLOC,BATCH,ITEM,NEWDATA(.01,"I"),-NEWDATA(17,"I"))
  1.  . . . I NEWDATA(.01,"I")'=OLDDATA(.01,"I") Q
  1.  . . . ; UPDATE INVENTORY changed
  1.  . . . I FLD=14 D
  1.  . . . . I OLDDATA(14,"I") D UPDINV^PSARDCUT(PHARMLOC,BATCH,ITEM,PSADRUG,OLDDATA(17,"I"))
  1.  . . . . I NEWDATA(14,"I") D UPDINV^PSARDCUT(PHARMLOC,BATCH,ITEM,PSADRUG,-NEWDATA(17,"I"))
  1.  . . . I NEWDATA(14,"I")'=OLDDATA(14,"I") Q
  1.  . . . ; DISPENSE QTY changed
  1.  . . . I FLD=17 D
  1.  . . . . I OLDDATA(14,"I") D UPDINV^PSARDCUT(PHARMLOC,BATCH,ITEM,PSADRUG,(OLDDATA(17,"I")-NEWDATA(17,"I")))
  1.  Q
  1.  ;
  1. LOGACT(FIELD,OLDVALUE,NEWVALUE,TYPE,COMM) ; - Log an activity for the return item
  1.  I $G(COMM)="" D
  1.  . S COMM=$$GET1^DID(58.3511,FIELD,"","LABEL")_" "
  1.  . S COMM=COMM_"changed from "_$S(OLDVALUE="":"''",1:OLDVALUE)_" to "_$S(NEWVALUE="":"''",1:NEWVALUE)_"."
  1.  D LOGACT^PSARDCUT(PHARMLOC,BATCH,ITEM,TYPE,COMM)
  1.  Q