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

PSARDCUT.m

Go to the documentation of this file.
  1. PSARDCUT ;BIRM/MFR - Return Drug - Utilities ;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 ^PSSNDCUT supported by IA #4707
  1. ;
  1. PHLOC() ;Select Pharmacy location
  1. N PSALOC,PSACNT,PSAOSIT,PSAOSITN,PSACOMB,PSAISIT,PSAISITN,PSALOCA
  1. N PSALOCN,PSAMENU,DIR,X,Y
  1. S PSALOC=+$O(^PSD(58.8,"ADISP","P",0)) I 'PSALOC D Q ""
  1. .W !!?5,"No Drug Accountability location has been created yet."
  1. ;
  1. ;If more than one pharmacy location, collect them in alpha order.
  1. S (PSACNT,PSALOC)=0
  1. F S PSALOC=+$O(^PSD(58.8,"ADISP","P",PSALOC)) Q:'PSALOC D
  1. .Q:'$D(^PSD(58.8,PSALOC,0))!($P($G(^PSD(58.8,PSALOC,0)),"^")="")
  1. .I +$G(^PSD(58.8,PSALOC,"I")),+^PSD(58.8,PSALOC,"I")'>DT Q
  1. .Q:'$O(^PSD(58.8,PSALOC,1,0))
  1. .S (PSAOSIT,PSAOSITN)=""
  1. .D SITES^PSAUTL1
  1. .S PSALOCA($P(^PSD(58.8,PSALOC,0),"^")_PSACOMB,PSALOC)=PSALOC_"^"_$P(^PSD(58.8,PSALOC,0),"^")_PSACOMB_"^"_$P(^(0),"^",3)_"^"_$P(^(0),"^",10)_"^"_$P($G(^PSD(58.8,PSALOC,"I")),"^")
  1. I $O(PSALOCA(""))="" Q ""
  1. S PSALOCN="" F S PSALOCN=$O(PSALOCA(PSALOCN)) Q:PSALOCN="" D
  1. .S PSALOC=0 F S PSALOC=$O(PSALOCA(PSALOCN,PSALOC)) Q:'PSALOC D
  1. ..S PSACNT=PSACNT+1,DIR("A",PSACNT)=PSACNT_". "_PSALOCN
  1. ..S PSAMENU(PSACNT,PSALOCN,PSALOC)=""
  1. S DIR("A",PSACNT+1)=""
  1. W !,"Choose one pharmacy location:",!
  1. S DIR(0)="NO^1:"_PSACNT,DIR("A")="Select PHARMACY LOCATION"
  1. S DIR("?")="Enter the number representing the Pharmacy Location"
  1. D ^DIR
  1. S PSALOCN=$O(PSAMENU(+Y,"")),PSALOC=$S(PSALOCN'="":+$O(PSAMENU(+Y,PSALOCN,0)),1:0)
  1. Q $S(+PSALOC>0:PSALOCA(PSALOCN,PSALOC),1:"")
  1. ;
  1. DTTM(DATE,SEC) ; Converts FM to MM/DD/YY@HHMM(SS) (w/ or /out seconds)
  1. ;
  1. Q $P($$FMTE^XLFDT(DATE,"2Z"),":",1,$S($G(SEC):3,1:2))
  1. ;
  1. LOGACT(PHLOC,BATCH,ITEM,TYPE,COMM) ; - Log an EDIT activity for the return item
  1. N DIC,DR,DA,X,Y,DINUM,DLAYGO,DD,DO
  1. I '$D(^PSD(58.35,PHLOC,"BAT",BATCH,"ITM",ITEM)) Q
  1. S DIC="^PSD(58.35,"_PHLOC_",""BAT"","_BATCH_",""ITM"","_ITEM_",""LOG"","
  1. S X=$$NOW^XLFDT(),DIC(0)="",DA(3)=PHLOC,DA(2)=BATCH,DA(1)=ITEM
  1. S DIC("DR")="1////^S X=DUZ;2///^S X=TYPE;3///^S X=COMM"
  1. K DD,DO D FILE^DICN K DD,DO
  1. ;
  1. Q
  1. ;
  1. DTRNG(BGN,END) ; Date Range Selection
  1. ;Input: (o) BGN - Default Begin Date
  1. ; (o) END - Default End Date
  1. ;
  1. N %DT,DTOUT,DUOUT,DTRNG,X,Y
  1. S DTRNG=""
  1. S %DT="AES",%DT("A")="BEGIN DATE: ",%DT("B")=$G(BGN) K:$G(BGN)="" %DT("B") D ^%DT
  1. I $G(DUOUT)!$G(DTOUT)!($G(Y)=-1) Q "^"
  1. S $P(DTRNG,U)=Y
  1. ;
  1. W ! K %DT
  1. S %DT="AES",%DT("A")="END DATE: ",%DT("B")=$G(END),%DT(0)=Y K:$G(END)="" %DT("B") D ^%DT
  1. I $G(DUOUT)!$G(DTOUT)!($G(Y)=-1) Q "^"
  1. ;
  1. ;Define Entry
  1. S $P(DTRNG,U,2)=Y
  1. ;
  1. Q DTRNG
  1. ;
  1. STASEL() ; Status Selection
  1. N PSARY,STR,I,DIR,X,Y
  1. S STR="AP:AWAITING PICKUP;PU:PICKED UP;CO:COMPLETED;CA:CANCELLED;ALL:ALL"
  1. W !,"Select one or multiple (separated by comma) of the following:"
  1. F I=1:1:$L(STR,";") D
  1. .S PSARY($P($P(STR,";",I),":"))=$P($P(STR,";",I),":",2)
  1. .S DIR("A",I)=$J($P($P(STR,";",I),":"),10)_" - "_$P($P(STR,";",I),":",2)
  1. S DIR("A",I+1)="Ex.: 'PU,CO' for PICKED UP and COMPLETED batches."
  1. S DIR("A",I+2)=""
  1. S DIR(0)="FO^^K:'$$STAVAL^PSARDCUT(Y,.PSARY) X",DIR("A")="STATUS(ES)"
  1. S DIR("?")="Enter one or multiple (separated by comma) from below:"
  1. S DIR("B")="ALL"
  1. D ^DIR I $D(DIRUT) Q ""
  1. S Y=$$UP^XLFSTR(Y)
  1. I $F(Y,"ALL") S Y="ALL"
  1. Q Y
  1. ;
  1. STAVAL(X,PSARY) ;Checks for valid combinations of statuses
  1. ; Input - X user input to be validated
  1. ; - PSARY array contains the valid statues
  1. ; Output - Return 1 valid or 0 invalid flag
  1. N II,FLG
  1. I $G(X)="" Q 0
  1. S X=$$UP^XLFSTR(X)
  1. S FLG=1
  1. F II=1:1:$L(X,",") D I 'FLG Q
  1. .I $P(X,",",II)="" S FLG=0 Q
  1. .I '$D(PSARY($P(X,",",II))) S FLG=0
  1. Q FLG
  1. ;
  1. UPDINV(PHLOC,BATCH,ITEM,DRUG,QTY,DISPLAY) ; - Update Drug Inventory
  1. N TYPE,BALANCE,TIMEOUT,COMM,TRANUM,DIC,DA,X,Y,DLAYGO,MONTH,BEGBAL,PREVMON,Z,DD,DO,D0
  1. N DINUM,DIE,DR,ENDBAL,TOTADJ,DRGMFR,EXPDT
  1. ;
  1. W !,"Updating Inventory "_$S($G(DISPLAY):"("_$$GET1^DIQ(50,DRUG,.01)_")",1:"")_"..."
  1. ;
  1. I '$D(^PSD(58.35,PHLOC,"BAT",BATCH,"ITM",ITEM)) W "Failed." H 1 Q
  1. ;
  1. S TYPE=$O(^PSD(58.84,"B","RETURNED TO MANUFACTURER",0))
  1. I 'TYPE D Q
  1. . W "Failed." H 1
  1. . D LOGACT(PHLOC,BATCH,ITEM,"X","Drug Accountability Inventory not updated: 'RETURNED TO MANUFACTURER' missing from the CS WORKSHEET file (#58.84).")
  1. ;
  1. I '$D(^PSD(58.8,PHLOC,1,DRUG,0)) D Q
  1. . W "Failed." H 1
  1. . D LOGACT(PHLOC,BATCH,ITEM,"X","Drug Accountability Inventory not updated: No current inventory information for Drug/Pharmacy Location.")
  1. ;
  1. ; - Updating current inventory
  1. F L +^PSD(58.8,PHLOC,1,DRUG):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
  1. S BALANCE=+$P($G(^PSD(58.8,PHLOC,1,DRUG,0)),"^",4)
  1. ;
  1. F TIMEOUT=20:-1:0 L:TIMEOUT +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
  1. I 'TIMEOUT L -^PSD(58.8,PHLOC,1,DRUG) D Q
  1. . W "Failed." H 1
  1. . D LOGACT(PHLOC,BATCH,ITEM,"X","Drug Accountability Inventory not updated: DRUG ACCOUNTABILITY TRANSACTION file (#58.81) locked.")
  1. ;
  1. S DRGMFR=$$GET1^DIQ(58.3511,ITEM_","_BATCH_","_PHLOC,2)
  1. S EXPDT=$$GET1^DIQ(58.3511,ITEM_","_BATCH_","_PHLOC,9)
  1. S COMM=$S(QTY<0:"RETURNED",1:"CANCELLED RETURN")_" FOR CREDIT: "_$$GET1^DIQ(58.3511,ITEM_","_BATCH_","_PHLOC,15)
  1. S TRANUM=$O(^PSD(58.81,999999999999),-1)+1
  1. S DIC="^PSD(58.81,",DIC(0)="",(DINUM,X)=TRANUM
  1. S DA=TRANUM
  1. S DIC("DR")="1////^S X=TYPE;2////^S X=PHLOC;3////^S X=$$NOW^XLFDT();4////^S X=DRUG"
  1. S DIC("DR")=DIC("DR")_";5////^S X=QTY;6////^S X=DUZ;9////^S X=(BALANCE+QTY)"
  1. S DIC("DR")=DIC("DR")_";12////^S X=DRGMFR;14////^S X=EXPDT;15////^S X=COMM"
  1. K DD,DO D FILE^DICN K DD,DO
  1. L -^PSD(58.81,0)
  1. ;
  1. S $P(^PSD(58.8,PHLOC,1,DRUG,0),"^",4)=(BALANCE+QTY)
  1. ;
  1. L -^PSD(58.8,PHLOC,1,DRUG)
  1. ;
  1. W "OK" H 1
  1. Q
  1. ;
  1. MONTH ; Monthly Activity update (Unsure if this should be done. So, not being called right now)
  1. I '$D(^PSD(58.35,PHLOC,"BAT",BATCH,"ITM",ITEM)) Q
  1. S DIC="^PSD(58.35,"_PHLOC_",""BAT"","_BATCH_",""ITM"","_ITEM_",""LOG"","
  1. S X=$$NOW^XLFDT(),DIC(0)="",DA(3)=PHLOC,DA(2)=BATCH,DA(1)=ITEM
  1. S DIC("DR")="1////^S X=DUZ;2///^S X=TYPE;3///^S X=COMM"
  1. K DD,DO D FILE^DICN K DD,DO
  1. ;
  1. S MONTH=DT\100*100
  1. S BEGBAL=0,PREVMON=$O(^PSD(58.8,PHLOC,1,DRUG,5,MONTH),-1)
  1. I PREVMON D
  1. . S BEGBAL=$P(^PSD(58.8,PHLOC,1,DRUG,5,PREVMON,0),"^",4) ; Ending balance from previous month
  1. I '$D(^PSD(58.8,PHLOC,1,DRUG,5,MONTH,0)) D
  1. . S DIC="^PSD(58.8,"_PHLOC_",1,"_DRUG_",5,",DIC(0)=""
  1. . S DIC("DR")="1////^S X=BEGBAL",(X,DINUM)=MONTH
  1. . S DA(2)=PHLOC,DA(1)=DRUG
  1. . K DD,DO D FILE^DICN K DD,DO
  1. S Z=$G(^PSD(58.8,PHLOC,1,DRUG,5,MONTH,0))
  1. S ENDBAL=$P(Z,"^",4),TOTADJ=$P(Z,"^",5)
  1. S DIE="^PSD(58.8,"_PHLOC_",1,"_DRUG_",5,",DA(2)=PHLOC,DA(1)=DRUG,DA=MONTH
  1. S DR="3////^S X="_(ENDBAL+QTY)_";7////^S X="_(TOTADJ+QTY)
  1. D ^DIE
  1. Q
  1. ;
  1. DEFCTMF() ; - Returns the default Contractor/Manufacturer (if there is only 1 active)
  1. N CTMF,CNT,DEFAULT,Z
  1. S (CTMF,CNT)=0 F S CTMF=$O(^PSD(58.36,CTMF)) Q:'CTMF D I CNT>1 Q
  1. . S Z=^PSD(58.36,CTMF,0) I DT<$P(Z,"^",2) Q
  1. . S CNT=CNT+1,DEFAULT=$P(Z,"^",1)
  1. Q $S(CNT=1:$G(DEFAULT),1:"")
  1. ;
  1. TOTCRE(PHLOC,BATCH) ; - Return Batch Total Estimated^Actual Credit
  1. N ITM,ESTOT,ACTOT,Z
  1. S (ITM,ESTOT,ACTOT)=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. . S ESTOT=ESTOT+$P(Z,"^",12),ACTOT=ACTOT+$P(Z,"^",13)
  1. Q $J(ESTOT,0,2)_"^"_$J(ACTOT,0,2)
  1. ;
  1. LIST(PHLOC,BATCH) ; - Items List
  1. N ITM,DSPLN,LIST,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. . S DSPLN=$E($E($$GET1^DIQ(50,+Z,.01),1,20)_" ("_$P(Z,"^",4)_")",1,36)
  1. . S $E(DSPLN,37)=$J($P(Z,"^",18),8),$E(DSPLN,46)=$P(Z,"^",9)
  1. . S LIST($$GET1^DIQ(50,+Z,.01),ITM)=DSPLN
  1. ;
  1. I $D(LIST) D
  1. . S $P(XX,"-",59)="" W !?10,XX,!?10," #",?13,"RETURN DRUG (NDC)",?49,"DISP QTY",?58,"UNIT",!?10,XX,!
  1. . S CNT=0,DRNAM="" F S DRNAM=$O(LIST(DRNAM)) Q:DRNAM="" D I $G(DIRUT) Q
  1. . . S ITM=0 F S ITM=$O(LIST(DRNAM,ITM)) Q:'ITM D I $G(DIRUT) Q
  1. . . . S CNT=CNT+1 W ?10,$J(CNT,2),?13,LIST(DRNAM,ITM) I '(CNT#15) S DIR(0)="E" D ^DIR W $C(13) Q
  1. . . . W !
  1. Q
  1. ;
  1. LMHDR(PHLOC,BATCH,LOCNAM) ; - Header for Batch/Item screens
  1. N LINE,PSALOC,PSACOMB
  1. S PSALOC=PHLOC D SITES^PSAUTL1
  1. S LINE(1)="Pharm Location: "_$E($$GET1^DIQ(58.8,PHLOC,.01)_$G(PSACOMB),1,32)
  1. S $E(LINE(1),51)="Date Created: "_$$DTTM^PSARDCUT($$GET1^DIQ(58.351,BATCH_","_PHLOC,3,"I"))
  1. S LINE(2)="Batch Number : "_$$GET1^DIQ(58.351,BATCH_","_PHLOC,.01)
  1. S $E(LINE(2),57)="Status: "_$$GET1^DIQ(58.351,BATCH_","_PHLOC,1)
  1. S LINE(3)="Rtn Contractor: "_$E($$GET1^DIQ(58.351,BATCH_","_PHLOC,4),1,31)
  1. S $E(LINE(3),49)="Date Picked Up: "_$$DTTM^PSARDCUT($$GET1^DIQ(58.351,BATCH_","_PHLOC,2,"I"))
  1. S LINE(4)="Reference # : "_$$GET1^DIQ(58.351,BATCH_","_PHLOC,5)
  1. S $E(LINE(4),45)="Total Batch Credit: $"_$P($$TOTCRE^PSARDCUT(PHLOC,BATCH),"^",2)
  1. K VALMHDR S VALMHDR(1)=LINE(1),VALMHDR(2)=LINE(2),VALMHDR(3)=LINE(3),VALMHDR(4)=LINE(4)
  1. Q
  1. ;
  1. EXCEL() ; - Returns whether to capture data for Excel report.
  1. ; Output: EXCEL = 1 - YES (capture data) / 0 - NO (DO NOT capture data)
  1. ;
  1. N EXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT
  1. ;
  1. S DIR(0)="Y",DIR("B")="NO",DIR("T")=DTIME W !
  1. S DIR("A")="Do you want to capture report data for an Excel document"
  1. S DIR("?")="^D EXCHLP^PSARDCUT"
  1. D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q "^"
  1. K DIROUT,DTOUT,DUOUT,DIRUT
  1. S EXCEL=0 I Y S EXCEL=1
  1. ;
  1. ;Display Excel display message
  1. I EXCEL=1 D EXCMSG
  1. ;
  1. Q EXCEL
  1. ;
  1. EXCHLP ; - 'Do you want to capture data...' prompt
  1. W !!," Enter: 'Y' - To capture detail report data to transfer"
  1. W !," to an Excel document"
  1. W !," '<CR>' - To skip this option"
  1. W !," '^' - To quit this option"
  1. Q
  1. ;
  1. EXCMSG ;Display the message about capturing to an Excel file format
  1. W !!?5,"Before continuing, please set up your terminal to capture the"
  1. W !?5,"detail report data. On some terminals, this can be done by"
  1. W !?5,"clicking on the 'Tools' menu above, then click on 'Capture"
  1. W !?5,"Incoming Data' to save to Desktop. This report may take a"
  1. W !?5,"while to run."
  1. W !!?5,"Note: To avoid undesired wrapping of the data saved to the"
  1. W !?5," file, please enter '0;256;999' at the 'DEVICE:' prompt.",!
  1. Q
  1. ;
  1. CHKEY() ; Check for keys to use Return Drug options
  1. I $D(^XUSEC("PSARET",DUZ))!$D(^XUSEC("PSAMGR",DUZ))!$D(^XUSEC("PSORPH",DUZ)) Q 1
  1. W !!,"Please contact your Pharmacy Coordinator for access to this option."
  1. W !,"The PSARET security key is required!",$C(7),!
  1. Q 0