GMRCINC ;SLC/JFR - list incomplete IFC transactions ; 2/12/02 15:05
;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
EN ; -- main entry point for GMRCIF INCOMPLETE TRANSACTION
N DIR,X,Y,DIRUT,DIROUT
S DIR(0)="PO^123:EMQ",DIR("A")="Select a consult request"
S DIR("?")="Type in the number, date of request or patient name"
S DIR("S")="I $D(^GMR(123.6,""AC"",+Y))"
D ^DIR
I $D(DIRUT) Q
I '$D(^GMR(123,+Y,0)) D Q
. W !,"There is no such consult request number"
. K DIR S DIR(0)="E" D ^DIR
S GMRCNUM=+Y
D BLD(GMRCNUM)
D EN^VALM("GMRC IF INCOMPLETE TRANSACTION")
Q
;
BLD(GMRCDA) ;get list of incomplete IF transactions for a consult #
; Input:
; GMRCDA = ien of consult from file 123
;
; Output:
; some kind of ^TMP( array
N GMRCLOG,ACT,ENT,LINE
S ACT=0
F S ACT=$O(^GMR(123.6,"AC",GMRCDA,ACT)) Q:'ACT D
. S ENT=$O(^GMR(123.6,"AC",GMRCDA,ACT,1,0)) Q:'ENT
. S GMRCLOG(ACT)=ENT
I '$O(GMRCLOG(0)) D Q
.S ^TMP("GMRCINC",$J,1,0)="No incomplete transactions for request #"_GMRCDA
S GMRCLOG=GMRCLOG($O(GMRCLOG(0)))
D EN^GMRCIERR(GMRCLOG,GMRCDA,$O(GMRCLOG(0)),1)
M ^TMP("GMRCINC",$J)=^TMP("GMRCIERR",$J)
S ACT=0
F S ACT=$O(GMRCLOG(ACT)) Q:'ACT D
. K ^TMP("GMRCIERR",$J)
. S LINE=$O(^TMP("GMRCINC",$J," "),-1)+1
. D ACTLG^GMRCIERR(GMRCDA,ACT,GMRCLOG(ACT),.LINE)
. I '$D(^TMP("GMRCIERR",$J)) Q
. S ^TMP("GMRCINC",$J,"B",ACT)=$O(^TMP("GMRCIERR",$J,0))+1
. S LINE=0 F S LINE=$O(^TMP("GMRCIERR",$J,LINE)) Q:'LINE D
.. S ^TMP("GMRCINC",$J,LINE+1,0)=^TMP("GMRCIERR",$J,LINE,0)
.. Q
. Q
K ^TMP("GMRCIERR",$J)
Q
;
HDR ; -- header code
S VALMHDR(1)="Incomplete transaction(s) for consult#: "_GMRCNUM
Q
;
INIT ; -- init variables and list array
N ACT,LIN
S VALMBG=1
S VALMCNT=$O(^TMP("GMRCINC",$J," "),-1)
S ACT=0 F S ACT=$O(^TMP("GMRCINC",$J,"B",ACT)) Q:'ACT D
. S LIN=^TMP("GMRCINC",$J,"B",ACT)
. D CNTRL^VALM10(LIN,1,14,IORVON,IORVOFF)
S VALMBCK="R"
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K GMRCNUM,GMRCSEL
K ^TMP("GMRCINC",$J),^TMP("GMRCS",$J)
Q
;
NEWCSLT ; pick new consult number to check for inc. trans.
N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
D FULL^VALM1
S DIR(0)="PO^123:EMQ",DIR("A")="Select a new Consult number"
S DIR("?")="Type in the number, date of request or patient name"
D ^DIR
I $D(DIRUT) Q
I '$D(^GMR(123,+Y,0)) D Q
. W !,"There is no such consult request number"
. K DIR S DIR(0)="E" D ^DIR
K ^TMP("GMRCINC",$J),^TMP("GMRCS",$J)
S GMRCNUM=+Y
I '$D(GMRCSEL) D
. D BLD(GMRCNUM)
. D INIT
. D HDR
E D
. S GMRCSEL=GMRCNUM
. K GMRCLOG
. D BLD^GMRCITR(GMRCNUM)
. I '$O(GMRCLOG(0)) D
.. S ^TMP("GMRCINC",$J,1,0)="No transactions for consult#: "_GMRCNUM
. E D
.. D DATA^GMRCITR(GMRCS)
. D HDR^GMRCITR,LM^GMRCITR
S VALMCNT=$O(^TMP("GMRCINC",$J," "),-1)
S VALMBG=1
Q
;
RETRAN ;resend a particular transaction
N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,GMRCACT
D FULL^VALM1
S GMRCACT=$$SELACT(GMRCNUM) I 'GMRCACT Q
I $O(^GMR(123.6,"AC",GMRCNUM,GMRCACT),-1)>0 D Q
. W !!,"There is at least one earlier incomplete transaction for this"
. W !,"consult, all incomplete transactions should be processed in "
. W !,"order.",!
. S DIR(0)="E" D ^DIR
W !
S DIR(0)="YA"
S DIR("A")="Are you sure you want to retransmit this activity? "
S DIR("A",1)="You have selected the following activity:"
S DIR("A",2)=$$GET1^DIQ(123.1,$P(^GMR(123,GMRCNUM,40,GMRCACT,0),U,2),.01)_" entered "_$$FMTE^XLFDT($P(^GMR(123,GMRCNUM,40,GMRCACT,0),U))
S DIR("A",3)=" "
D ^DIR
I +Y'=1 Q
D DELALRT^GMRCIBKG($O(^GMR(123.6,"AC",GMRCNUM,GMRCACT,1,0)))
D TRIGR^GMRCIEVT(GMRCNUM,GMRCACT)
S VALMBG=1
Q
;
SELACT(GMRCDA) ;select an incomplete activity
N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,GMRC40
S DIR(0)="N",DIR("A")="Select an activity number" D ^DIR
I $D(DIRUT) Q ""
S GMRC40=+Y
K DIR
I '$D(^GMR(123,GMRCDA,40,GMRC40)) D Q ""
. W !,"There is no such activity number for consult# "_GMRCNUM
. S DIR(0)="E" D ^DIR
I '$D(^GMR(123.6,"AC",GMRCDA,GMRC40)) D Q ""
. W !,"There is no incomplete IFC transaction for that activity"
. S DIR(0)="E" D ^DIR
Q GMRC40
;
MKCOMP ; mark a particular transaction complete
N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,GMRCACT,FDA,GMRCLOG,GMRCERR
D FULL^VALM1
S GMRCACT=$$SELACT(GMRCNUM) I 'GMRCACT Q
W !
S DIR(0)="YA"
S DIR("A")="Are you sure you want to mark this activity complete? "
S DIR("A",1)="You have selected the following activity:"
S DIR("A",2)=$$GET1^DIQ(123.1,$P(^GMR(123,GMRCNUM,40,GMRCACT,0),U,2),.01)_" entered "_$$FMTE^XLFDT($P(^GMR(123,GMRCNUM,40,GMRCACT,0),U))
S DIR("A",3)=" "
S DIR("A",4)="Use Caution marking a transaction complete!"
S DIR("A",5)=" "
D ^DIR
I +$G(Y)'=1 Q
S GMRCLOG=$O(^GMR(123.6,"AC",GMRCNUM,GMRCACT,1,0))
I 'GMRCLOG Q
S FDA(1,123.6,GMRCLOG_",",.06)="@"
D UPDATE^DIE("","FDA(1)",,"GMRCERR")
K ^TMP("GMRCINC",$J),^TMP("GMRCS",$J)
D BLD(GMRCNUM)
D INIT
S VALMBG=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCINC 5018 printed Apr 09, 2024@20:50:56 Page 2
GMRCINC ;SLC/JFR - list incomplete IFC transactions ; 2/12/02 15:05
+1 ;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
EN ; -- main entry point for GMRCIF INCOMPLETE TRANSACTION
+1 NEW DIR,X,Y,DIRUT,DIROUT
+2 SET DIR(0)="PO^123:EMQ"
SET DIR("A")="Select a consult request"
+3 SET DIR("?")="Type in the number, date of request or patient name"
+4 SET DIR("S")="I $D(^GMR(123.6,""AC"",+Y))"
+5 DO ^DIR
+6 IF $DATA(DIRUT)
QUIT
+7 IF '$DATA(^GMR(123,+Y,0))
Begin DoDot:1
+8 WRITE !,"There is no such consult request number"
+9 KILL DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+10 SET GMRCNUM=+Y
+11 DO BLD(GMRCNUM)
+12 DO EN^VALM("GMRC IF INCOMPLETE TRANSACTION")
+13 QUIT
+14 ;
BLD(GMRCDA) ;get list of incomplete IF transactions for a consult #
+1 ; Input:
+2 ; GMRCDA = ien of consult from file 123
+3 ;
+4 ; Output:
+5 ; some kind of ^TMP( array
+6 NEW GMRCLOG,ACT,ENT,LINE
+7 SET ACT=0
+8 FOR
SET ACT=$ORDER(^GMR(123.6,"AC",GMRCDA,ACT))
if 'ACT
QUIT
Begin DoDot:1
+9 SET ENT=$ORDER(^GMR(123.6,"AC",GMRCDA,ACT,1,0))
if 'ENT
QUIT
+10 SET GMRCLOG(ACT)=ENT
End DoDot:1
+11 IF '$ORDER(GMRCLOG(0))
Begin DoDot:1
+12 SET ^TMP("GMRCINC",$JOB,1,0)="No incomplete transactions for request #"_GMRCDA
End DoDot:1
QUIT
+13 SET GMRCLOG=GMRCLOG($ORDER(GMRCLOG(0)))
+14 DO EN^GMRCIERR(GMRCLOG,GMRCDA,$ORDER(GMRCLOG(0)),1)
+15 MERGE ^TMP("GMRCINC",$JOB)=^TMP("GMRCIERR",$JOB)
+16 SET ACT=0
+17 FOR
SET ACT=$ORDER(GMRCLOG(ACT))
if 'ACT
QUIT
Begin DoDot:1
+18 KILL ^TMP("GMRCIERR",$JOB)
+19 SET LINE=$ORDER(^TMP("GMRCINC",$JOB," "),-1)+1
+20 DO ACTLG^GMRCIERR(GMRCDA,ACT,GMRCLOG(ACT),.LINE)
+21 IF '$DATA(^TMP("GMRCIERR",$JOB))
QUIT
+22 SET ^TMP("GMRCINC",$JOB,"B",ACT)=$ORDER(^TMP("GMRCIERR",$JOB,0))+1
+23 SET LINE=0
FOR
SET LINE=$ORDER(^TMP("GMRCIERR",$JOB,LINE))
if 'LINE
QUIT
Begin DoDot:2
+24 SET ^TMP("GMRCINC",$JOB,LINE+1,0)=^TMP("GMRCIERR",$JOB,LINE,0)
+25 QUIT
End DoDot:2
+26 QUIT
End DoDot:1
+27 KILL ^TMP("GMRCIERR",$JOB)
+28 QUIT
+29 ;
HDR ; -- header code
+1 SET VALMHDR(1)="Incomplete transaction(s) for consult#: "_GMRCNUM
+2 QUIT
+3 ;
INIT ; -- init variables and list array
+1 NEW ACT,LIN
+2 SET VALMBG=1
+3 SET VALMCNT=$ORDER(^TMP("GMRCINC",$JOB," "),-1)
+4 SET ACT=0
FOR
SET ACT=$ORDER(^TMP("GMRCINC",$JOB,"B",ACT))
if 'ACT
QUIT
Begin DoDot:1
+5 SET LIN=^TMP("GMRCINC",$JOB,"B",ACT)
+6 DO CNTRL^VALM10(LIN,1,14,IORVON,IORVOFF)
End DoDot:1
+7 SET VALMBCK="R"
+8 QUIT
+9 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL GMRCNUM,GMRCSEL
+2 KILL ^TMP("GMRCINC",$JOB),^TMP("GMRCS",$JOB)
+3 QUIT
+4 ;
NEWCSLT ; pick new consult number to check for inc. trans.
+1 NEW DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+2 DO FULL^VALM1
+3 SET DIR(0)="PO^123:EMQ"
SET DIR("A")="Select a new Consult number"
+4 SET DIR("?")="Type in the number, date of request or patient name"
+5 DO ^DIR
+6 IF $DATA(DIRUT)
QUIT
+7 IF '$DATA(^GMR(123,+Y,0))
Begin DoDot:1
+8 WRITE !,"There is no such consult request number"
+9 KILL DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+10 KILL ^TMP("GMRCINC",$JOB),^TMP("GMRCS",$JOB)
+11 SET GMRCNUM=+Y
+12 IF '$DATA(GMRCSEL)
Begin DoDot:1
+13 DO BLD(GMRCNUM)
+14 DO INIT
+15 DO HDR
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 SET GMRCSEL=GMRCNUM
+18 KILL GMRCLOG
+19 DO BLD^GMRCITR(GMRCNUM)
+20 IF '$ORDER(GMRCLOG(0))
Begin DoDot:2
+21 SET ^TMP("GMRCINC",$JOB,1,0)="No transactions for consult#: "_GMRCNUM
End DoDot:2
+22 IF '$TEST
Begin DoDot:2
+23 DO DATA^GMRCITR(GMRCS)
End DoDot:2
+24 DO HDR^GMRCITR
DO LM^GMRCITR
End DoDot:1
+25 SET VALMCNT=$ORDER(^TMP("GMRCINC",$JOB," "),-1)
+26 SET VALMBG=1
+27 QUIT
+28 ;
RETRAN ;resend a particular transaction
+1 NEW DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,GMRCACT
+2 DO FULL^VALM1
+3 SET GMRCACT=$$SELACT(GMRCNUM)
IF 'GMRCACT
QUIT
+4 IF $ORDER(^GMR(123.6,"AC",GMRCNUM,GMRCACT),-1)>0
Begin DoDot:1
+5 WRITE !!,"There is at least one earlier incomplete transaction for this"
+6 WRITE !,"consult, all incomplete transactions should be processed in "
+7 WRITE !,"order.",!
+8 SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+9 WRITE !
+10 SET DIR(0)="YA"
+11 SET DIR("A")="Are you sure you want to retransmit this activity? "
+12 SET DIR("A",1)="You have selected the following activity:"
+13 SET DIR("A",2)=$$GET1^DIQ(123.1,$PIECE(^GMR(123,GMRCNUM,40,GMRCACT,0),U,2),.01)_" entered "_$$FMTE^XLFDT($PIECE(^GMR(123,GMRCNUM,40,GMRCACT,0),U))
+14 SET DIR("A",3)=" "
+15 DO ^DIR
+16 IF +Y'=1
QUIT
+17 DO DELALRT^GMRCIBKG($ORDER(^GMR(123.6,"AC",GMRCNUM,GMRCACT,1,0)))
+18 DO TRIGR^GMRCIEVT(GMRCNUM,GMRCACT)
+19 SET VALMBG=1
+20 QUIT
+21 ;
SELACT(GMRCDA) ;select an incomplete activity
+1 NEW DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,GMRC40
+2 SET DIR(0)="N"
SET DIR("A")="Select an activity number"
DO ^DIR
+3 IF $DATA(DIRUT)
QUIT ""
+4 SET GMRC40=+Y
+5 KILL DIR
+6 IF '$DATA(^GMR(123,GMRCDA,40,GMRC40))
Begin DoDot:1
+7 WRITE !,"There is no such activity number for consult# "_GMRCNUM
+8 SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT ""
+9 IF '$DATA(^GMR(123.6,"AC",GMRCDA,GMRC40))
Begin DoDot:1
+10 WRITE !,"There is no incomplete IFC transaction for that activity"
+11 SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT ""
+12 QUIT GMRC40
+13 ;
MKCOMP ; mark a particular transaction complete
+1 NEW DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,GMRCACT,FDA,GMRCLOG,GMRCERR
+2 DO FULL^VALM1
+3 SET GMRCACT=$$SELACT(GMRCNUM)
IF 'GMRCACT
QUIT
+4 WRITE !
+5 SET DIR(0)="YA"
+6 SET DIR("A")="Are you sure you want to mark this activity complete? "
+7 SET DIR("A",1)="You have selected the following activity:"
+8 SET DIR("A",2)=$$GET1^DIQ(123.1,$PIECE(^GMR(123,GMRCNUM,40,GMRCACT,0),U,2),.01)_" entered "_$$FMTE^XLFDT($PIECE(^GMR(123,GMRCNUM,40,GMRCACT,0),U))
+9 SET DIR("A",3)=" "
+10 SET DIR("A",4)="Use Caution marking a transaction complete!"
+11 SET DIR("A",5)=" "
+12 DO ^DIR
+13 IF +$GET(Y)'=1
QUIT
+14 SET GMRCLOG=$ORDER(^GMR(123.6,"AC",GMRCNUM,GMRCACT,1,0))
+15 IF 'GMRCLOG
QUIT
+16 SET FDA(1,123.6,GMRCLOG_",",.06)="@"
+17 DO UPDATE^DIE("","FDA(1)",,"GMRCERR")
+18 KILL ^TMP("GMRCINC",$JOB),^TMP("GMRCS",$JOB)
+19 DO BLD(GMRCNUM)
+20 DO INIT
+21 SET VALMBG=1
+22 QUIT
