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

ECXPROEE.m

Go to the documentation of this file.
  1. ECXPROEE ;ALB/DAN - Prosthetics Extract Edit ;2/14/19 15:21
  1. ;;3.0;DSS EXTRACTS;**161,174**;Dec 22, 1997;Build 33
  1. ;
  1. EN ;entry point from menu option
  1. N DIR,DIRUT,ECXX,Y,STOP,ECPIECE
  1. S ECXX="PRO",ECPIECE=23
  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. S $P(^ECX(728,1,7.1),"^",ECPIECE)=""
  1. Q
  1. ;
  1. EXTEDT ;Edit extract
  1. N DIC,DIE,DA,DR,DTOUT,DUOUT,Y,D,DIR,DIRUT
  1. S DA=$$GETSEQ(727.826) Q:'+DA
  1. 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."
  1. D ^DIR
  1. I Y=+$P(^ECX(727.826,DA,0),U,12)!($G(DIRUT)) Q ;Quantity didn't change or user exited
  1. S DIC="^ECX(727.826,",DR="11////"_$$RJ^XLFSTR(Y,8,0) ;Expand answer to have leading zeroes
  1. D TURNON^DIAUTL(727.826,"11","y")
  1. S DIE=DIC D ^DIE
  1. D TURNON^DIAUTL(727.826,"11","n")
  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
  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 ;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^ECXPROEE X"
  1. S DIR("A")="Select "_$G(ECXX)_" EXTRACT SEQUENCE NUMBER: "
  1. S DIR("?")="^D HELP2^ECXPROEE"
  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^ECXPROEE(X)) X"
  1. S DIR("A")="Select "_$G(ECXX)_" EXTRACT NUMBER: "
  1. S DIR("?")="^D HELP^ECXPROEE"
  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. 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
  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. .W !,SEQNO,?12,$P(^ECX(FILE,SEQNO,0),U,6),?24,$$ECXDATEX^ECXUTL($P(^(0),U,9)),?39,+$P(^(0),U,12)
  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. W !,"SEQUENCE #",?12,"SSN",?24,"DELIVERY DATE",?39,"QUANTITY"
  1. W !,$$REPEAT^XLFSTR("-",48)
  1. Q