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

ECXPHVE.m

Go to the documentation of this file. 
  1. ECXPHVE ;ALB/JAM - Pharmacy Volume Edit ;5/28/15  14:29
  1.  ;;3.0;DSS EXTRACTS;**92,120,136,154**;Dec 22, 1997;Build 13
  1.  ;
  1. EN ;entry point from menu option
  1.  N DIR,DIRUT,ECXX,Y,STOP,ECPIECE
  1.  N $ESTACK,$ETRAP S $ETRAP="D RESET^ECXPHVE"
  1.  S DIR(0)="SO^P:PRE;I:IVP;U:UDP;B:BCM" ;154 BCM ADDED
  1.  D ^DIR I $D(DIRUT) Q
  1.  S DIR("A")="Which extract do you need to edit?"
  1.  S ECXX=Y(0),ECPIECE=$S(ECXX="PRE":2,ECXX="IVP":19,ECXX="BCM":29,1:8) ;Added BCM 154
  1.  S STOP=0 I $P($G(^ECX(728,1,7.1)),"^",ECPIECE)]"" D  I STOP Q
  1.  .W !!,ECXX," Extract running, cannot edit. Try later.",!! S STOP=1
  1.  .K DIR S DIR(0)="E" D ^DIR
  1.  S $P(^ECX(728,1,7.1),"^",ECPIECE)="R"
  1.  D EXTEDT
  1.  Q
  1.  ;
  1. EXTEDT ;Edit extracts - PRE, IVP, or UDP
  1.  N DIC,DIE,DA,DR,DTOUT,DUOUT,Y,D
  1.  ;PRE extract (file #727.1) edit Quantity (field #16) & Unit of Issue (field #22)
  1.  I ECXX="PRE" D
  1.  .S DA=$$GETSEQ(727.81)
  1.  .S DIC="^ECX(727.81,",DR="16;22"
  1.  .D TURNON^DIAUTL(727.81,"16;22","y")
  1.  ;IVP extract (file #727.819) edit Quantity (field #10)&Total Doses per Day (#20)
  1.  I ECXX="IVP" D
  1.  .S DA=$$GETSEQ(727.819)
  1.  .S DIC="^ECX(727.819,",DR="10;20"
  1.  .D TURNON^DIAUTL(727.819,"10;20","y")
  1.  ;UDP extract (file #727.809) edit Quantity (field #10)
  1.  I ECXX="UDP" D
  1.  .S DA=$$GETSEQ(727.809)
  1.  .S DIC="^ECX(727.809,",DR="10"
  1.  .D TURNON^DIAUTL(727.809,"10","y")
  1.  ;BCM extract (file #727.833) edit Component Dose Given (field #31) & Component Units (field #32) 154
  1.  I ECXX="BCM" D
  1.  .S DA=$$GETSEQ(727.833)
  1.  .S DIC="^ECX(727.833,",DR="31;32"
  1.  .D TURNON^DIAUTL(727.833,"31;32","y")
  1.  S DIE=DIC D ^DIE
  1. RESET I $G(ECXX)="" Q
  1.  I ECXX="PRE" D TURNON^DIAUTL(727.81,"16;22","n")
  1.  I ECXX="IVP" D TURNON^DIAUTL(727.819,"10;20","n")
  1.  I ECXX="UDP" D TURNON^DIAUTL(727.809,"10","n")
  1.  I ECXX="BCM" D TURNON^DIAUTL(727.833,"31;32","n") ;154
  1.  I $G(ECPIECE) S $P(^ECX(728,1,7.1),"^",ECPIECE)=""
  1.  Q
  1. CKREC(ECXN) ;Checks if record should be edited.
  1.  I ECXN="" Q 0
  1.  I $G(^ECX(727,ECXN,"PURG"))'="" Q 0
  1.  I $G(^ECX(727,ECXN,"TR"))'="" Q 0
  1.  I $G(^ECX(727,ECXN,"Q"))'="" Q 0
  1.  Q 1
  1.  ;
  1. CHKSEQ() ;Check sequence to see if it can be edited - API added in 136
  1.  N CANEDIT
  1.  S CANEDIT=1
  1.  I '$D(^ECX(FILE,X,0)) S CANEDIT=0
  1.  I +SSN I $P($G(^ECX(FILE,X,0)),U,6)'=SSN S CANEDIT=0
  1.  I '$D(^ECX(FILE,"AC",EXT,X)) S CANEDIT=0 ;154 Added check to be sure sequence number is in selected extract
  1.  Q CANEDIT
  1.  ;
  1. GETSEQ(FILE) ;Get sequence number to edit
  1.  N EXT,SEQ,DIR,SSN
  1.  S SEQ=0
  1.  S EXT=$$GETEXT(FILE) I '+EXT Q SEQ  ;Nothing selected
  1.  S SSN=$$GETSSN I SSN=-1 Q SEQ
  1.  S DIR(0)="NA^1:1000000000^K:'$$CHKSEQ^ECXPHVE X"
  1.  S DIR("A")="Select "_$G(ECXX)_" EXTRACT SEQUENCE NUMBER: "
  1.  S DIR("?")="^D HELP2^ECXPHVE"
  1.  D ^DIR
  1.  I Y>0 S SEQ=+Y
  1.  Q SEQ
  1.  ;
  1. GETEXT(FILE) ;get extract number
  1.  N DIR,RES
  1.  S RES=0
  1.  S DIR(0)="NA^1:10000000:0^K:'$D(^ECX(FILE,""AC"",X))!('$$CKREC^ECXPHVE(X)) X"
  1.  S DIR("A")="Select "_$G(ECXX)_" EXTRACT NUMBER: "
  1.  S DIR("?")="^D HELP^ECXPHVE"
  1.  D ^DIR
  1.  I +Y S RES=+Y
  1.  Q RES
  1.  ;
  1. HELP ;
  1.  N NUM
  1.  W !,"Select from one of the following extract numbers:",!,"If no numbers appear then there are no extracts that can",!,"be edited.",!
  1.  S NUM=0 F  S NUM=$O(^ECX(FILE,"AC",NUM)) Q:'+NUM  I $$CKREC(NUM) W !,NUM
  1.  Q
  1.  ;
  1. GETSSN() ;
  1.  N DIR,NUM,DUOUT,DTOUT
  1.  S NUM=0
  1.  S DIR(0)="FAO^9:10^K:X'?9N&(X'?9N1""P"") X"
  1.  S DIR("A")="Enter patient's SSN, if known, or press ENTER to continue: "
  1.  S DIR("?",1)="Enter patient's SSN, if known.  The SSN will be used to find sequence numbers"
  1.  S DIR("?",2)="associated with this patient.  Enter 9 digits or 9 digits and P, no"
  1.  S DIR("?")="hyphens or spaces.  Entry is optional."
  1.  D ^DIR
  1.  I $L(Y)=9!($L(Y)=10) S NUM=Y
  1.  I $D(DUOUT)!($D(DTOUT)) S NUM=-1
  1.  Q NUM
  1.  ;
  1. HELP2 ;Display list of sequence numbers to choose from
  1.  N SEQNO,DIR,Y,CNT
  1.  W !,"Select from one of the following sequence numbers:"
  1.  S Y=1,CNT=0
  1.  D HDR
  1.  S SEQNO=0 F  S SEQNO=$O(^ECX(FILE,"AC",EXT,SEQNO)) Q:'+SEQNO!('+Y)  D
  1.  .I SSN I $P($G(^ECX(FILE,SEQNO,0)),U,6)'=SSN Q  ;Check for SSN if user entered
  1.  .;154 Added BCM fieldS
  1.  .W !,SEQNO,?12,$P(^ECX(FILE,SEQNO,0),U,6),?24,$$ECXDATEX^ECXUTL($P(^(0),U,9)),?38,$S(FILE'=727.833:$P(^(0),U,$S(FILE=727.81:17,1:11)),1:$P(^(1),U,7))
  1.  .W @$S(ECXX'="BCM":"?48",1:"?62"),$S(FILE=727.81:$P(^(0),U,23),FILE=727.819:$P(^(0),U,20),FILE=727.833:$P(^(1),U,8),1:"") S CNT=CNT+1
  1.  .I CNT>18 S DIR(0)="E" D ^DIR S CNT=0 D HDR
  1.  Q
  1.  ;
  1. HDR ;
  1.  ;154 Added BCM fields 154
  1.  W !,"SEQUENCE #",?12,"SSN",?24,$S(ECXX="PRE":"FILL DT",1:"DISPENSE DT"),?38,$S(ECXX'="BCM":"QUANTITY",1:"COMPONENT DOSE GIVEN")
  1.  W @$S(ECXX'="BCM":"?48",1:"?62"),$S(ECXX="PRE":"UNIT OF ISSUE",ECXX="IVP":"TOTAL DOSES/DAY",ECXX="BCM":"COMPONENT UNITS",1:"")
  1.  W !,$$REPEAT^XLFSTR("-",$S(ECXX="UDP":48,ECXX="BCM":78,1:64)) ;154
  1.  Q