- 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 Jan 18, 2025@02:54:48 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