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

PSARDCIT.m

Go to the documentation of this file. 
  1. 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
  1.  ;References to ORDER UNIT file (#51.5) supported by IA #1931
  1.  ;
  1. EN(PSAPHLOC,PSABATCH,PSAITEM) ; - ListManager entry point
  1.  ;
  1.  D EN^VALM("PSA RETURN DRUG BATCH ITEM")
  1.  D FULL^VALM1
  1.  G EXIT
  1.  ;
  1. HDR ; - Header
  1.  D LMHDR^PSARDCUT(PSAPHLOC,PSABATCH)
  1.  Q
  1.  ;
  1. INIT ; - Populates the Body section for ListMan
  1.  K ^TMP("PSARDCIT",$J)
  1.  S VALMCNT=0
  1.  D SETLINE
  1.  S VALMSG="Enter ?? for more actions"
  1.  Q
  1.  ;
  1. SETLINE ; - Sets the line to be displayed in ListMan
  1.  N LINE,SEQ,DATA,FLDS
  1.  K ^TMP("PSARDCIT",$J)
  1.  S SEQ=0
  1.  D GETS^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC_",","*","IE","FLDS")
  1.  K DATA M DATA=FLDS(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC_",")
  1.  S LINE="          Drug: "_$E(DATA(.01,"E"),1,26),$E(LINE,44)="Credit Status: "_DATA(10,"E") D SETTMP
  1.  S LINE="  Manufacturer: "_$E(DATA(2,"E"),1,30),$E(LINE,48)="Exp. Date: "_$$FMTE^XLFDT(DATA(9,"I"),"2ZM") D SETTMP
  1.  S LINE="           NDC: "_$E(DATA(3,"E"),1,30),$E(LINE,47)="Created By: "_$E($G(DATA(16,"E")),1,22) D SETTMP
  1.  S LINE="           UPC: "_$E(DATA(4,"E"),1,30),$E(LINE,47)="Created On: "_$$FMTE^XLFDT(DATA(1,"I"),"2ZM") D SETTMP
  1.  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
  1.  S LINE="      Dsp Unit: "_$E(DATA(8,"E"),1,27),$E(LINE,44)="Actual Credit: $"_$J(DATA(12,"E"),0,2) D SETTMP
  1.  S LINE="          DUOU: "_$E(DATA(7,"E"),1,27),$E(LINE,44)="Return Reason: "_DATA(15,"E") D SETTMP
  1.  S LINE="Return Ord Qty: "_DATA(6,"E"),$E(LINE,43)="Upd. Inventory: "_DATA(14,"E") D SETTMP
  1.  S LINE="Return Dsp Qty: "_DATA(17,"E") D SETTMP
  1.  S LINE="" D SETTMP
  1.  S LINE="Activity Log" D SETTMP D CNTRL^VALM10(SEQ,1,80,IOUON,IOINORM)
  1.  S LINE="DATE/TIME",$E(LINE,20)="ACTION",$E(LINE,30)="USER" D SETTMP
  1.  D CNTRL^VALM10(SEQ,1,80,IOUON,IOINORM)
  1.  D ACTLOG
  1.  S VALMCNT=SEQ
  1.  Q
  1.  ;
  1. ACTLOG ; - Gets lines for activity log
  1.  N LOG,FLDS,LINE,PSALOG,I,COMM
  1.  S LOG=0
  1.  F  S LOG=$O(^PSD(58.35,PSAPHLOC,"BAT",PSABATCH,"ITM",PSAITEM,"LOG",LOG)) Q:'LOG  D
  1.  .D GETS^DIQ(58.35111,LOG_","_PSAITEM_","_PSABATCH_","_PSAPHLOC_",","*","IE","FLDS")
  1.  .M PSALOG=FLDS(58.35111,LOG_","_PSAITEM_","_PSABATCH_","_PSAPHLOC_",")
  1.  .S LINE=$$FMTE^XLFDT(PSALOG(.01,"I"),"2Z"),$E(LINE,20)=PSALOG(2,"E"),$E(LINE,30)=PSALOG(1,"E") D SETTMP
  1.  .S COMM=PSALOG(3,"E") I $L(COMM)>80 D
  1.  ..F I=$L(COMM," "):-1:1 I $L($P(COMM," ",1,I))<80 D  Q
  1.  ...S LINE=$P(COMM," ",1,I) D SETTMP S LINE=$P(COMM," ",I+1,$L(COMM," ")) D SETTMP
  1.  .E  S LINE=COMM D SETTMP
  1.  Q
  1.  ;
  1. SETTMP ; Set ^TMP("PSARDCIT",$J, array
  1.  S SEQ=SEQ+1,^TMP("PSARDCIT",$J,SEQ,0)=LINE
  1.  Q
  1.  ;
  1. EDT ; - Single Item Edit
  1.  N PSANODE,PSALCK,BATST
  1.  D FULL^VALM1
  1.  W ! S BATST=$$BATSTA(PSAPHLOC,PSABATCH) I '+BATST D  Q
  1.  .S VALMSG=$P(BATST,"^",2),VALMBCK="R" W $C(7)
  1.  S PSANODE="^PSD(58.35,"_PSAPHLOC_",""BAT"","_PSABATCH_",""ITM"","_PSAITEM_")"
  1.  S PSALCK=$$LK(PSANODE) I 'PSALCK D  W $C(7) Q
  1.  .S VALMSG="Record locked by another user. Try again later!",VALMBCK="R"
  1.  D ITEM^PSARDCU1(PSAPHLOC,PSABATCH,PSAITEM),UNLK(PSANODE),SETLINE
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. CAN ; - Single Item Cancel
  1.  N BATST,PSANODE,PSALCK,DIR,DIK,DA,X,Y,DRUG,UPINV,DUNTS
  1.  D FULL^VALM1
  1.  W ! S BATST=$$BATSTA(PSAPHLOC,PSABATCH) I '+BATST D  Q
  1.  .S VALMSG=$P(BATST,"^",2),VALMBCK="R" W $C(7)
  1.  I $$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1,"I")="PU" D  W $C(7) Q
  1.  .S VALMSG="Cannot change. This batch has been picked up",VALMBCK="R"
  1.  S PSANODE="^PSD(58.35,"_PSAPHLOC_",""BAT"","_PSABATCH_",""ITM"","_PSAITEM_")"
  1.  S PSALCK=$$LK(PSANODE) I 'PSALCK D  W $C(7) Q
  1.  .S VALMSG="Record locked by another user. Try again later!",VALMBCK="R"
  1.  S DIR(0)="Y",DIR("A")="     Confirm",DIR("B")="N"
  1.  D ^DIR I ($D(DIRUT))!('Y) D  Q
  1.  .S VALMSG="Cancel aborted...",VALMBCK="R" W $C(7) D UNLK(PSANODE)
  1.  S DRUG=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,.01,"I")
  1.  S UPINV=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,14,"I")
  1.  S DUNTS=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,17,"I")
  1.  ;call to update inventory
  1.  I UPINV,+DUNTS>0 D UPDINV^PSARDCUT(PSAPHLOC,PSABATCH,PSAITEM,DRUG,DUNTS)
  1.  ;delete record
  1.  S DA(2)=PSAPHLOC,DA(1)=PSABATCH,DA=PSAITEM
  1.  S DIK="^PSD(58.35,"_DA(2)_",""BAT"","_DA(1)_",""ITM"","
  1.  D ^DIK,UNLK(PSANODE)
  1.  S VALMSG="Item removed!",VALMBCK="Q"
  1.  Q
  1.  ;
  1. CRE ; - Single Item Credit Update
  1.  N DIR,DIRUT,DA,X,Y,BATST,PSANODE,PSALCK,PSAISTA,PSAIAMT,CREAMT,OISTA
  1.  N FLDD,PSACOM,CRESTA,ACTAMT,ESTAMT
  1.  D FULL^VALM1
  1.  W ! S BATST=$$BATSTA(PSAPHLOC,PSABATCH)
  1.  I $P(BATST,"^",2)'="PU" D  S VALMBCK="R" W $C(7) Q
  1.  .S VALMSG="Batch status must be PICKED UP to update credit!"
  1.  S PSANODE="^PSD(58.35,"_PSAPHLOC_",""BAT"","_PSABATCH_",""ITM"","_PSAITEM_")"
  1.  S PSALCK=$$LK(PSANODE) I 'PSALCK D  W $C(7) Q
  1.  .S VALMSG="Record locked by another user. Try again later!",VALMBCK="R"
  1.  S DIR(0)="58.3511,10",DIR("A")="CREDIT STATUS"
  1.  S OISTA=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,10,"I")
  1.  S DIR("B")=$S(OISTA="":"P",1:OISTA)
  1.  D ^DIR I $D(DIRUT) D  Q
  1.  .S VALMSG="Credit Update aborted",VALMBCK="R" D UNLK(PSANODE)
  1.  S PSAISTA=Y,(PSAIAMT,CREAMT)="",CRESTA=$$EXTERNAL^DILFD(58.3511,10,,Y)
  1.  K DIR,X,Y,DA W !
  1.  ;Only ask for amount when status is Actual or Estimated
  1.  I ("^A^E^")[("^"_PSAISTA_"^") D
  1.  .S FLDD=$S(PSAISTA="A":12,1:11) ;,DIR(0)="58.3511,"_FLDD
  1.  .S DIR(0)="NA^0.01:999999999:2",DIR("?")="Type a Dollar amount between 0 and 999999999, 2 Decimal Digits"
  1.  .S CREAMT=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,FLDD,"I")
  1.  .I CREAMT'="" S DIR("B")=$J(CREAMT,0,2)
  1.  .S DIR("A")=$$EXTERNAL^DILFD(58.3511,10,,PSAISTA)_" CREDIT AMOUNT: "
  1.  .D ^DIR
  1.  .S PSAIAMT=Y
  1.  I $D(DIRUT) D  Q
  1.  .S VALMSG="Credit Update aborted",VALMBCK="R" W $C(7) D UNLK(PSANODE)
  1.  K DIR,X,Y,DA W !
  1.  S DIR(0)="Y",DIR("A")="  Save Credit",DIR("B")="N"
  1.  D ^DIR I $D(DIRUT)!('Y) D  Q
  1.  .S VALMSG="Credit Update aborted...",VALMBCK="R" W $C(7) D UNLK(PSANODE)
  1.  ; if record unchanged, quit.
  1.  I OISTA=PSAISTA,CREAMT=PSAIAMT S VALMBCK="R" Q
  1.  I OISTA'=PSAISTA D
  1.  .S PSACOM="CREDIT STATUS changed from "_$S(OISTA="":"''",1:$$EXTERNAL^DILFD(58.3511,10,,OISTA))_" to "_$$EXTERNAL^DILFD(58.3511,10,,PSAISTA)_". "
  1.  .D LOGACT^PSARDCUT(PSAPHLOC,PSABATCH,PSAITEM,"E",PSACOM)
  1.  I ("^A^E^")[("^"_PSAISTA_"^") D
  1.  .S PSACOM=$$EXTERNAL^DILFD(58.3511,10,,PSAISTA)_" CREDIT AMOUNT changed from "_$S(CREAMT="":"''",1:"$"_$J(CREAMT,0,2))_" to $"_$J(PSAIAMT,0,2)_"."
  1.  .D LOGACT^PSARDCUT(PSAPHLOC,PSABATCH,PSAITEM,"E",PSACOM)
  1.  I ("^P^D^")[("^"_PSAISTA_"^") D
  1.  .S PSACOM=""
  1.  .S ESTAMT=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,11,"I")
  1.  .I ESTAMT'="" S PSACOM="ESTIMATED CREDIT AMOUNT of $"_$J(ESTAMT,0,2)
  1.  .S ACTAMT=$$GET1^DIQ(58.3511,PSAITEM_","_PSABATCH_","_PSAPHLOC,12,"I")
  1.  .I ACTAMT'="" S PSACOM=PSACOM_$S(PSACOM="":"",1:" and ")_"ACTUAL CREDIT AMOUNT of $"_$J(ACTAMT,0,2)
  1.  .I PSACOM'="" S PSACOM=PSACOM_$S(PSACOM["and":" were",1:" was")_" automatically deleted."
  1.  .I PSACOM'="" D LOGACT^PSARDCUT(PSAPHLOC,PSABATCH,PSAITEM,"E",PSACOM)
  1.  D ITMUPD,UNLK(PSANODE),HDR,SETLINE
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. ITMUPD ; - Single Item File Update
  1.  N PSAIENS,PSARY
  1.  S DA(2)=PSAPHLOC,DA(1)=PSABATCH,DA=PSAITEM
  1.  S PSAIENS=$$IENS^DILF(.DA)
  1.  S PSARY(58.3511,PSAIENS,10)=PSAISTA
  1.  I ("^A^E^")[("^"_PSAISTA_"^") S PSARY(58.3511,PSAIENS,FLDD)=PSAIAMT
  1.  I ("^P^D^")[("^"_PSAISTA_"^") D
  1.  .S PSARY(58.3511,PSAIENS,11)=""
  1.  .S PSARY(58.3511,PSAIENS,12)=""
  1.  D UPDATE^DIE("","PSARY")
  1.  Q
  1.  ;
  1. BATSTA(PSAPHLOC,PSABATCH) ; - Returns if a batch is editable
  1.  ; Input:   PSAPHLOC - Pharmacy location
  1.  ;          PSABATCH - Batch IEN from ^PSD(58.35,
  1.  ; Output:  1^Batch Status
  1.  ;          0^Error message
  1.  N BATST,MSG
  1.  S BATST=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLOC,1,"I")
  1.  I "^CO^CA^"[BATST D  Q 0_"^"_MSG
  1.  .S MSG="Cannot change. This batch has been "_$S(BATST="CO":"completed.",1:"cancelled.")
  1.  Q 1_"^"_BATST
  1.  ;
  1. LK(NODE) ;- Locks node
  1.  L +@NODE:$S($G(DILOCKTM)>0:DILOCKTM,1:3) Q $T
  1.  ;
  1. UNLK(NODE) ;Unlocks node
  1.  L -@NODE
  1.  Q
  1. EXIT ;
  1.  K ^TMP("PSARDCIT",$J)
  1.  Q
  1.  ;
  1. HELP ;
  1.  Q