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