ECXPROEE ;ALB/DAN - Prosthetics Extract Edit ;2/14/19 15:21
;;3.0;DSS EXTRACTS;**161,174**;Dec 22, 1997;Build 33
;
EN ;entry point from menu option
N DIR,DIRUT,ECXX,Y,STOP,ECPIECE
S ECXX="PRO",ECPIECE=23
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
S $P(^ECX(728,1,7.1),"^",ECPIECE)=""
Q
;
EXTEDT ;Edit extract
N DIC,DIE,DA,DR,DTOUT,DUOUT,Y,D,DIR,DIRUT
S DA=$$GETSEQ(727.826) Q:'+DA
S DIR(0)="NOA^1:1000",DIR("A")="QUANTITY: ",DIR("B")=+$P(^ECX(727.826,DA,0),U,12),DIR("?")="Enter quantity. Must be between 1 and 1000 with no decimal digits."
D ^DIR
I Y=+$P(^ECX(727.826,DA,0),U,12)!($G(DIRUT)) Q ;Quantity didn't change or user exited
S DIC="^ECX(727.826,",DR="11////"_$$RJ^XLFSTR(Y,8,0) ;Expand answer to have leading zeroes
D TURNON^DIAUTL(727.826,"11","y")
S DIE=DIC D ^DIE
D TURNON^DIAUTL(727.826,"11","n")
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
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 ;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^ECXPROEE X"
S DIR("A")="Select "_$G(ECXX)_" EXTRACT SEQUENCE NUMBER: "
S DIR("?")="^D HELP2^ECXPROEE"
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^ECXPROEE(X)) X"
S DIR("A")="Select "_$G(ECXX)_" EXTRACT NUMBER: "
S DIR("?")="^D HELP^ECXPROEE"
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
W !!,"NOTE: For Vista records with Unit of Issue=MO, the extract Unit of Issue",!,"and Quantity have been converted from months to days.",! ;174
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
.W !,SEQNO,?12,$P(^ECX(FILE,SEQNO,0),U,6),?24,$$ECXDATEX^ECXUTL($P(^(0),U,9)),?39,+$P(^(0),U,12)
.S CNT=CNT+1
.I CNT>18 S DIR(0)="E" D ^DIR S CNT=0 D HDR
Q
;
HDR ;
W !,"SEQUENCE #",?12,"SSN",?24,"DELIVERY DATE",?39,"QUANTITY"
W !,$$REPEAT^XLFSTR("-",48)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXPROEE 3547 printed Apr 09, 2024@20:59:25 Page 2
ECXPROEE ;ALB/DAN - Prosthetics Extract Edit ;2/14/19 15:21
+1 ;;3.0;DSS EXTRACTS;**161,174**;Dec 22, 1997;Build 33
+2 ;
EN ;entry point from menu option
+1 NEW DIR,DIRUT,ECXX,Y,STOP,ECPIECE
+2 SET ECXX="PRO"
SET ECPIECE=23
+3 SET STOP=0
IF $PIECE($GET(^ECX(728,1,7.1)),"^",ECPIECE)]""
Begin DoDot:1
+4 WRITE !!,ECXX," Extract running, cannot edit. Try later.",!!
SET STOP=1
+5 KILL DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
IF STOP
QUIT
+6 SET $PIECE(^ECX(728,1,7.1),"^",ECPIECE)="R"
+7 DO EXTEDT
+8 SET $PIECE(^ECX(728,1,7.1),"^",ECPIECE)=""
+9 QUIT
+10 ;
EXTEDT ;Edit extract
+1 NEW DIC,DIE,DA,DR,DTOUT,DUOUT,Y,D,DIR,DIRUT
+2 SET DA=$$GETSEQ(727.826)
if '+DA
QUIT
+3 SET DIR(0)="NOA^1:1000"
SET DIR("A")="QUANTITY: "
SET DIR("B")=+$PIECE(^ECX(727.826,DA,0),U,12)
SET DIR("?")="Enter quantity. Must be between 1 and 1000 with no decimal digits."
+4 DO ^DIR
+5 ;Quantity didn't change or user exited
IF Y=+$PIECE(^ECX(727.826,DA,0),U,12)!($GET(DIRUT))
QUIT
+6 ;Expand answer to have leading zeroes
SET DIC="^ECX(727.826,"
SET DR="11////"_$$RJ^XLFSTR(Y,8,0)
+7 DO TURNON^DIAUTL(727.826,"11","y")
+8 SET DIE=DIC
DO ^DIE
+9 DO TURNON^DIAUTL(727.826,"11","n")
+10 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
+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 ;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^ECXPROEE X"
+6 SET DIR("A")="Select "_$GET(ECXX)_" EXTRACT SEQUENCE NUMBER: "
+7 SET DIR("?")="^D HELP2^ECXPROEE"
+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^ECXPROEE(X)) X"
+4 SET DIR("A")="Select "_$GET(ECXX)_" EXTRACT NUMBER: "
+5 SET DIR("?")="^D HELP^ECXPROEE"
+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 ;174
WRITE !!,"NOTE: For Vista records with Unit of Issue=MO, the extract Unit of Issue",!,"and Quantity have been converted from months to days.",!
+3 SET NUM=0
+4 SET DIR(0)="FAO^9:10^K:X'?9N&(X'?9N1""P"") X"
+5 SET DIR("A")="Enter patient's SSN, if known, or press ENTER to continue: "
+6 SET DIR("?",1)="Enter patient's SSN, if known. The SSN will be used to find sequence numbers"
+7 SET DIR("?",2)="associated with this patient. Enter 9 digits or 9 digits and P, no"
+8 SET DIR("?")="hyphens or spaces. Entry is optional."
+9 DO ^DIR
+10 IF $LENGTH(Y)=9!($LENGTH(Y)=10)
SET NUM=Y
+11 IF $DATA(DUOUT)!($DATA(DTOUT))
SET NUM=-1
+12 QUIT NUM
+13 ;
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 WRITE !,SEQNO,?12,$PIECE(^ECX(FILE,SEQNO,0),U,6),?24,$$ECXDATEX^ECXUTL($PIECE(^(0),U,9)),?39,+$PIECE(^(0),U,12)
+8 SET CNT=CNT+1
+9 IF CNT>18
SET DIR(0)="E"
DO ^DIR
SET CNT=0
DO HDR
End DoDot:1
+10 QUIT
+11 ;
HDR ;
+1 WRITE !,"SEQUENCE #",?12,"SSN",?24,"DELIVERY DATE",?39,"QUANTITY"
+2 WRITE !,$$REPEAT^XLFSTR("-",48)
+3 QUIT
