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