- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCITR 5933 printed Jan 18, 2025@02:47:24 Page 2
- 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