- 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 Jan 18, 2025@02:47:19 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