GMRCITR ;SLC/JAK - IFC transactions ; 09/27/02 15:50
;;3.0;CONSULT/REQUEST TRACKING;**22,28**;DEC 27, 1997
EN ; -- main entry point for GMRC IF TRANSACTION
N GMRCDAS,GMRCLOG,GMRCQUT,GMRCS,X,Y
N GMRCDT1,GMRCDT2,GMRCEDT1,GMRCEDT2
D CON I $D(GMRCQUT) D EXIT^GMRCINC Q
;Ask for date range
D ^GMRCSPD
I $D(GMRCQUT) D EXIT^GMRCINC Q
D LISTDATE^GMRCSTU1(GMRCDT1,GMRCDT2,.GMRCEDT1,.GMRCEDT2)
D VIEW I $D(GMRCQUT) D EXIT^GMRCINC Q
I GMRCSEL="ALL" D
. S GMRCNUM=0 F S GMRCNUM=$O(^GMR(123.6,"C",GMRCNUM)) Q:'GMRCNUM D
.. D BLD(GMRCNUM)
E D
. S GMRCNUM=GMRCSEL
. D BLD(GMRCNUM)
I '$O(GMRCLOG(0)) D
. S ^TMP("GMRCINC",$J,1,0)="No transactions for consult#: "_GMRCSEL
E D
. D DATA(GMRCS)
D EN^VALM("GMRC IF TRANSACTION")
Q
;
CON ; ask for consult number or all
S GMRCSEL=0
F D ASK S:X["^" GMRCQUT=1 Q:X["^" Q:X="ALL" D LKUP Q:GMRCSEL
Q
ASK ; write prompt, do read
W !!,"Select Consult/Request Number: ALL// "
R X:DTIME
I '$T S X="^"
I X'["^" S X=$S('$L(X):"ALL",1:X)
S:X="ALL" GMRCSEL="ALL"
Q
LKUP ; use value of x for lookup
N DIC
S DIC="^GMR(123,",DIC(0)="MNEQZ"
D ^DIC I '$D(Y(0)) W "...invalid entry"
S:Y>0 GMRCSEL=+Y
Q
VIEW ; ask for sort/view
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
K GMRCQUT
;old code
; S DIR(0)="SA^C:CONSULT;D:DATE;A:ACTIVITY;M:MESSAGE STATUS"
; S DIR("A")="View by (C)onsult, (D)ate, (A)ctivity or (M)essage Status: "
;new code w/ patch 28
S DIR(0)="SA^C:CONSULT;D:DATE;A:ACTIVITY"
S DIR("A")="View by (C)onsult, (D)ate, or (A)ctivity: "
S DIR("B")="Consult"
S DIR("?")="Data will be sorted by your selection."
D ^DIR I $D(DIRUT) S GMRCQUT=1 Q
S GMRCS=Y
Q
BLD(GMRCDA) ; get list of IF transactions for one or all consults
; Input:
; GMRCDA = ien of consult from file 123
;
N ACT,ENT,GMRCDTE
S ACT=0
F S ACT=$O(^GMR(123.6,"C",GMRCDA,ACT)) Q:'ACT D
. S ENT=$O(^GMR(123.6,"C",GMRCDA,ACT,0)) Q:'ENT
. I $S(GMRCDT1="ALL":0,1:1) D Q:GMRCDTE<GMRCDT1!(GMRCDTE'<GMRCDT2)
.. S GMRCDTE=+$P($G(^GMR(123.6,ENT,0)),"^")
.. S GMRCDT2=GMRCDT2+1
. S GMRCLOG(GMRCDA,ACT)=ENT
Q
DATA(GMRCS) ; get data for IF transaction(s)
; Input:
; GMRCS = sort/view by selection
; Output:
; ^TMP("GMRCINC",$J array
N ACT,GMRCSV,TAB
I $O(GMRCLOG(0)) D
. K GMRCDAS
. K ^TMP("GMRCS",$J),^TMP("GMRCINC",$J)
S (GMRCDA,LINE)=0
S TAB="",$P(TAB," ",30)=""
F S GMRCDA=$O(GMRCLOG(GMRCDA)) Q:'GMRCDA D
. S ACT=0
. F S ACT=$O(GMRCLOG(GMRCDA,ACT)) Q:'ACT D
.. S GMRCLOG=$G(GMRCLOG(GMRCDA,ACT)) D
... N ACTTXT,EDT,IERR,STA,GMRCACT,GMRCLOG0
... S GMRCLOG0=$G(^GMR(123.6,GMRCLOG,0)) Q:'GMRCLOG0
... S GMRCDA(0)=$G(^GMR(123,GMRCDA,40,ACT,0)) Q:'GMRCDA(0)
... S LINE=LINE+1
... S X=$P(GMRCLOG0,"^") D REGDTM^GMRCU
... S EDT=$S(X]"":X,1:"No Date/Time")
... S GMRCACT=$P(GMRCDA(0),"^",2)
... S ACTTXT=$P($G(^GMR(123.1,+GMRCACT,0)),"^",1)
... S:'$L(ACTTXT) ACTTXT=GMRCACT_" action?"
... S STA=$P(GMRCLOG0,"^",3),STA=$$MSGSTAT^HLUTIL(STA) ; IA #3098
... S STA=$S(+STA>0:$E($$GET1^DIQ(771.6,+STA,.01),1,22),1:"No Status")
... S IERR=$T(@("ERR"_$P(GMRCLOG0,"^",8)_"^GMRCIUTL"))
... S IERR=$S(IERR]"":$E($P(IERR,";",2),1,45),1:"No Error")
... ;
... S GMRCDAS(GMRCDA)=""
... ; sort data
... S GMRCSV=$S(GMRCS="C":GMRCDA,GMRCS="D":EDT,GMRCS="A":ACTTXT,1:STA)
... S ^TMP("GMRCS",$J,GMRCSV,GMRCLOG)=GMRCDA
... S ^TMP("GMRCS",$J,GMRCSV,GMRCLOG)=^TMP("GMRCS",$J,GMRCSV,GMRCLOG)_$E(TAB,1,13-$L(^(GMRCLOG)))_EDT_$E(TAB,1,5)_ACTTXT
... ;S ^TMP("GMRCS",$J,GMRCSV,GMRCLOG)=^TMP("GMRCS",$J,GMRCSV,GMRCLOG)_$E(TAB,1,56-$L(^(GMRCLOG)))_STA ;msg status not included after patch 28
... S ^TMP("GMRCS",$J,GMRCSV,GMRCLOG)=^TMP("GMRCS",$J,GMRCSV,GMRCLOG)_$E(TAB,1,56-$L(^(GMRCLOG)))_IERR
.. Q
. ; set data in array name
. N GMRC1,LINE
. S GMRC1="",LINE=0
. F S GMRC1=$O(^TMP("GMRCS",$J,GMRC1)) Q:GMRC1="" D
.. N GMRC2
.. S GMRC2=""
.. F S GMRC2=$O(^TMP("GMRCS",$J,GMRC1,GMRC2)) Q:GMRC2="" D
... S LINE=LINE+1
... S ^TMP("GMRCINC",$J,LINE,0)=$G(^TMP("GMRCS",$J,GMRC1,GMRC2))
.. Q
. Q
Q
;
HDR ; -- header code
S VALMHDR(1)="Transaction(s) for consult#: "_GMRCSEL
S VALMHDR(2)="From: "_$G(GMRCEDT1)_" To: "_$G(GMRCEDT2)
Q
LM ; set caption line
D CHGCAP^VALM("CAPTION LINE","Consult Entry Date/Time Activity Error")
;D CHGCAP^VALM("CAPTION LINE 1","Error") ; error moved over w/ patch 28
Q
SELECT ; select a consult for detailed display of information
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,GMRCDDS
K GMRCLOG
S DIR(0)="NO^1:9999999^D CKSEL^GMRCITR(X) K:'GMRCDDS X"
S DIR("A")="Select a Consult number from the display"
S DIR("?")="This response must be a number from the display."
D ^DIR I $D(DIRUT) Q
K ^TMP("GMRCINC",$J)
S GMRCSEL=Y
D BLD(GMRCSEL)
N ACT,ENT,GMRCND,LINE
S (ACT,LINE)=0
F S ACT=$O(^GMR(123.6,"C",GMRCSEL,ACT)) Q:'ACT D
. S ENT=$O(^GMR(123.6,"C",GMRCSEL,ACT,0)) Q:'ENT D
.. Q:'$D(^GMR(123.6,ENT,0))
.. N DIC,DR,DA,DIQ,GMRCA
.. S DIC="^GMR(123.6,",DR=".01:.08",DA=ENT,DIQ="GMRCA"
.. D EN^DIQ1
.. S LINE=LINE+1
.. S GMRCND="^TMP(""GMRCINC"",$J,LINE,0)"
.. S @GMRCND="ENTRY DATE/TIME: "_GMRCA(123.6,ENT,.01),LINE=LINE+1
.. S @GMRCND="FACILITY: "_GMRCA(123.6,ENT,.02),LINE=LINE+1
.. S @GMRCND="MESSAGE #: "_GMRCA(123.6,ENT,.03),LINE=LINE+1
.. S @GMRCND="ACTIVITY #: "_GMRCA(123.6,ENT,.05),LINE=LINE+1
.. S @GMRCND="INCOMPLETE: "_GMRCA(123.6,ENT,.06),LINE=LINE+1
.. S @GMRCND="TRANS. ATTEMPTS: "_GMRCA(123.6,ENT,.07),LINE=LINE+1
.. S @GMRCND="ERROR: "_GMRCA(123.6,ENT,.08),LINE=LINE+1
.. S @GMRCND=""
S VALMHDR(1)="Detailed Display"
S VALMHDR(2)="Consult#: "_GMRCSEL
D CHGCAP^VALM("CAPTION LINE","")
D CHGCAP^VALM("CAPTION LINE 1","")
S VALMCNT=$O(^TMP("GMRCINC",$J," "),-1)
S VALMBG=1
Q
CKSEL(X) ; check selection
N GMRCDA
S (GMRCDA,GMRCDDS)=0
F S GMRCDA=$O(GMRCDAS(GMRCDA)) Q:'GMRCDA!GMRCDDS D
. I GMRCDA=X S GMRCDDS=1
Q
GMRCITR ;SLC/JAK - IFC transactions ; 09/27/02 15:50
+1 ;;3.0;CONSULT/REQUEST TRACKING;**22,28**;DEC 27, 1997
EN ; -- main entry point for GMRC IF TRANSACTION
+1 NEW GMRCDAS,GMRCLOG,GMRCQUT,GMRCS,X,Y
+2 NEW GMRCDT1,GMRCDT2,GMRCEDT1,GMRCEDT2
+3 DO CON
IF $DATA(GMRCQUT)
DO EXIT^GMRCINC
QUIT
+4 ;Ask for date range
+5 DO ^GMRCSPD
+6 IF $DATA(GMRCQUT)
DO EXIT^GMRCINC
QUIT
+7 DO LISTDATE^GMRCSTU1(GMRCDT1,GMRCDT2,.GMRCEDT1,.GMRCEDT2)
+8 DO VIEW
IF $DATA(GMRCQUT)
DO EXIT^GMRCINC
QUIT
+9 IF GMRCSEL="ALL"
Begin DoDot:1
+10 SET GMRCNUM=0
FOR
SET GMRCNUM=$ORDER(^GMR(123.6,"C",GMRCNUM))
IF 'GMRCNUM
QUIT
Begin DoDot:2
+11 DO BLD(GMRCNUM)
End DoDot:2
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 SET GMRCNUM=GMRCSEL
+14 DO BLD(GMRCNUM)
End DoDot:1
+15 IF '$ORDER(GMRCLOG(0))
Begin DoDot:1
+16 SET ^TMP("GMRCINC",$JOB,1,0)="No transactions for consult#: "_GMRCSEL
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 DO DATA(GMRCS)
End DoDot:1
+19 DO EN^VALM("GMRC IF TRANSACTION")
+20 QUIT
+21 ;
CON ; ask for consult number or all
+1 SET GMRCSEL=0
+2 FOR
DO ASK
IF X["^"
SET GMRCQUT=1
IF X["^"
QUIT
IF X="ALL"
QUIT
DO LKUP
IF GMRCSEL
QUIT
+3 QUIT
ASK ; write prompt, do read
+1 WRITE !!,"Select Consult/Request Number: ALL// "
+2 READ X:DTIME
+3 IF '$TEST
SET X="^"
+4 IF X'["^"
SET X=$SELECT('$LENGTH(X):"ALL",1:X)
+5 IF X="ALL"
SET GMRCSEL="ALL"
+6 QUIT
LKUP ; use value of x for lookup
+1 NEW DIC
+2 SET DIC="^GMR(123,"
SET DIC(0)="MNEQZ"
+3 DO ^DIC
IF '$DATA(Y(0))
WRITE "...invalid entry"
+4 IF Y>0
SET GMRCSEL=+Y
+5 QUIT
VIEW ; ask for sort/view
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 KILL GMRCQUT
+3 ;old code
+4 ; S DIR(0)="SA^C:CONSULT;D:DATE;A:ACTIVITY;M:MESSAGE STATUS"
+5 ; S DIR("A")="View by (C)onsult, (D)ate, (A)ctivity or (M)essage Status: "
+6 ;new code w/ patch 28
+7 SET DIR(0)="SA^C:CONSULT;D:DATE;A:ACTIVITY"
+8 SET DIR("A")="View by (C)onsult, (D)ate, or (A)ctivity: "
+9 SET DIR("B")="Consult"
+10 SET DIR("?")="Data will be sorted by your selection."
+11 DO ^DIR
IF $DATA(DIRUT)
SET GMRCQUT=1
QUIT
+12 SET GMRCS=Y
+13 QUIT
BLD(GMRCDA) ; get list of IF transactions for one or all consults
+1 ; Input:
+2 ; GMRCDA = ien of consult from file 123
+3 ;
+4 NEW ACT,ENT,GMRCDTE
+5 SET ACT=0
+6 FOR
SET ACT=$ORDER(^GMR(123.6,"C",GMRCDA,ACT))
IF 'ACT
QUIT
Begin DoDot:1
+7 SET ENT=$ORDER(^GMR(123.6,"C",GMRCDA,ACT,0))
IF 'ENT
QUIT
+8 IF $SELECT(GMRCDT1="ALL":0,1:1)
Begin DoDot:2
+9 SET GMRCDTE=+$PIECE($GET(^GMR(123.6,ENT,0)),"^")
+10 SET GMRCDT2=GMRCDT2+1
End DoDot:2
IF GMRCDTE<GMRCDT1!(GMRCDTE'<GMRCDT2)
QUIT
+11 SET GMRCLOG(GMRCDA,ACT)=ENT
End DoDot:1
+12 QUIT
DATA(GMRCS) ; get data for IF transaction(s)
+1 ; Input:
+2 ; GMRCS = sort/view by selection
+3 ; Output:
+4 ; ^TMP("GMRCINC",$J array
+5 NEW ACT,GMRCSV,TAB
+6 IF $ORDER(GMRCLOG(0))
Begin DoDot:1
+7 KILL GMRCDAS
+8 KILL ^TMP("GMRCS",$JOB),^TMP("GMRCINC",$JOB)
End DoDot:1
+9 SET (GMRCDA,LINE)=0
+10 SET TAB=""
SET $PIECE(TAB," ",30)=""
+11 FOR
SET GMRCDA=$ORDER(GMRCLOG(GMRCDA))
IF 'GMRCDA
QUIT
Begin DoDot:1
+12 SET ACT=0
+13 FOR
SET ACT=$ORDER(GMRCLOG(GMRCDA,ACT))
IF 'ACT
QUIT
Begin DoDot:2
+14 SET GMRCLOG=$GET(GMRCLOG(GMRCDA,ACT))
Begin DoDot:3
+15 NEW ACTTXT,EDT,IERR,STA,GMRCACT,GMRCLOG0
+16 SET GMRCLOG0=$GET(^GMR(123.6,GMRCLOG,0))
IF 'GMRCLOG0
QUIT
+17 SET GMRCDA(0)=$GET(^GMR(123,GMRCDA,40,ACT,0))
IF 'GMRCDA(0)
QUIT
+18 SET LINE=LINE+1
+19 SET X=$PIECE(GMRCLOG0,"^")
DO REGDTM^GMRCU
+20 SET EDT=$SELECT(X]"":X,1:"No Date/Time")
+21 SET GMRCACT=$PIECE(GMRCDA(0),"^",2)
+22 SET ACTTXT=$PIECE($GET(^GMR(123.1,+GMRCACT,0)),"^",1)
+23 IF '$LENGTH(ACTTXT)
SET ACTTXT=GMRCACT_" action?"
+24 ; IA #3098
SET STA=$PIECE(GMRCLOG0,"^",3)
SET STA=$$MSGSTAT^HLUTIL(STA)
+25 SET STA=$SELECT(+STA>0:$EXTRACT($$GET1^DIQ(771.6,+STA,.01),1,22),1:"No Status")
+26 SET IERR=$TEXT(@("ERR"_$PIECE(GMRCLOG0,"^",8)_"^GMRCIUTL"))
+27 SET IERR=$SELECT(IERR]"":$EXTRACT($PIECE(IERR,";",2),1,45),1:"No Error")
+28 ;
+29 SET GMRCDAS(GMRCDA)=""
+30 ; sort data
+31 SET GMRCSV=$SELECT(GMRCS="C":GMRCDA,GMRCS="D":EDT,GMRCS="A":ACTTXT,1:STA)
+32 SET ^TMP("GMRCS",$JOB,GMRCSV,GMRCLOG)=GMRCDA
+33 SET ^TMP("GMRCS",$JOB,GMRCSV,GMRCLOG)=^TMP("GMRCS",$JOB,GMRCSV,GMRCLOG)_$EXTRACT(TAB,1,13-$LENGTH(^(GMRCLOG)))_EDT_$EXTRACT(TAB,1,5)_ACTTXT
+34 ;S ^TMP("GMRCS",$J,GMRCSV,GMRCLOG)=^TMP("GMRCS",$J,GMRCSV,GMRCLOG)_$E(TAB,1,56-$L(^(GMRCLOG)))_STA ;msg status not included after patch 28
+35 SET ^TMP("GMRCS",$JOB,GMRCSV,GMRCLOG)=^TMP("GMRCS",$JOB,GMRCSV,GMRCLOG)_$EXTRACT(TAB,1,56-$LENGTH(^(GMRCLOG)))_IERR
End DoDot:3
+36 QUIT
End DoDot:2
+37 ; set data in array name
+38 NEW GMRC1,LINE
+39 SET GMRC1=""
SET LINE=0
+40 FOR
SET GMRC1=$ORDER(^TMP("GMRCS",$JOB,GMRC1))
IF GMRC1=""
QUIT
Begin DoDot:2
+41 NEW GMRC2
+42 SET GMRC2=""
+43 FOR
SET GMRC2=$ORDER(^TMP("GMRCS",$JOB,GMRC1,GMRC2))
IF GMRC2=""
QUIT
Begin DoDot:3
+44 SET LINE=LINE+1
+45 SET ^TMP("GMRCINC",$JOB,LINE,0)=$GET(^TMP("GMRCS",$JOB,GMRC1,GMRC2))
End DoDot:3
+46 QUIT
End DoDot:2
+47 QUIT
End DoDot:1
+48 QUIT
+49 ;
HDR ; -- header code
+1 SET VALMHDR(1)="Transaction(s) for consult#: "_GMRCSEL
+2 SET VALMHDR(2)="From: "_$GET(GMRCEDT1)_" To: "_$GET(GMRCEDT2)
+3 QUIT
LM ; set caption line
+1 DO CHGCAP^VALM("CAPTION LINE","Consult Entry Date/Time Activity Error")
+2 ;D CHGCAP^VALM("CAPTION LINE 1","Error") ; error moved over w/ patch 28
+3 QUIT
SELECT ; select a consult for detailed display of information
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,GMRCDDS
+2 KILL GMRCLOG
+3 SET DIR(0)="NO^1:9999999^D CKSEL^GMRCITR(X) K:'GMRCDDS X"
+4 SET DIR("A")="Select a Consult number from the display"
+5 SET DIR("?")="This response must be a number from the display."
+6 DO ^DIR
IF $DATA(DIRUT)
QUIT
+7 KILL ^TMP("GMRCINC",$JOB)
+8 SET GMRCSEL=Y
+9 DO BLD(GMRCSEL)
+10 NEW ACT,ENT,GMRCND,LINE
+11 SET (ACT,LINE)=0
+12 FOR
SET ACT=$ORDER(^GMR(123.6,"C",GMRCSEL,ACT))
IF 'ACT
QUIT
Begin DoDot:1
+13 SET ENT=$ORDER(^GMR(123.6,"C",GMRCSEL,ACT,0))
IF 'ENT
QUIT
Begin DoDot:2
+14 IF '$DATA(^GMR(123.6,ENT,0))
QUIT
+15 NEW DIC,DR,DA,DIQ,GMRCA
+16 SET DIC="^GMR(123.6,"
SET DR=".01:.08"
SET DA=ENT
SET DIQ="GMRCA"
+17 DO EN^DIQ1
+18 SET LINE=LINE+1
+19 SET GMRCND="^TMP(""GMRCINC"",$J,LINE,0)"
+20 SET @GMRCND="ENTRY DATE/TIME: "_GMRCA(123.6,ENT,.01)
SET LINE=LINE+1
+21 SET @GMRCND="FACILITY: "_GMRCA(123.6,ENT,.02)
SET LINE=LINE+1
+22 SET @GMRCND="MESSAGE #: "_GMRCA(123.6,ENT,.03)
SET LINE=LINE+1
+23 SET @GMRCND="ACTIVITY #: "_GMRCA(123.6,ENT,.05)
SET LINE=LINE+1
+24 SET @GMRCND="INCOMPLETE: "_GMRCA(123.6,ENT,.06)
SET LINE=LINE+1
+25 SET @GMRCND="TRANS. ATTEMPTS: "_GMRCA(123.6,ENT,.07)
SET LINE=LINE+1
+26 SET @GMRCND="ERROR: "_GMRCA(123.6,ENT,.08)
SET LINE=LINE+1
+27 SET @GMRCND=""
End DoDot:2
End DoDot:1
+28 SET VALMHDR(1)="Detailed Display"
+29 SET VALMHDR(2)="Consult#: "_GMRCSEL
+30 DO CHGCAP^VALM("CAPTION LINE","")
+31 DO CHGCAP^VALM("CAPTION LINE 1","")
+32 SET VALMCNT=$ORDER(^TMP("GMRCINC",$JOB," "),-1)
+33 SET VALMBG=1
+34 QUIT
CKSEL(X) ; check selection
+1 NEW GMRCDA
+2 SET (GMRCDA,GMRCDDS)=0
+3 FOR
SET GMRCDA=$ORDER(GMRCDAS(GMRCDA))
IF 'GMRCDA!GMRCDDS
QUIT
Begin DoDot:1
+4 IF GMRCDA=X
SET GMRCDDS=1
End DoDot:1
+5 QUIT
