IVMLERR2 ;ALB/RMO,ERC - IVM Transmission Error Processing - Protocols; 15-SEP-1997 ; 5/29/07 9:29am
;;2.0;INCOME VERIFICATION MATCH;**9,121**; 21-OCT-94;Build 45
;
;This routine contains the IVM transmission log error processing
;protocols.
;
;See EN^IVMLERR1 for additional documentation on 'system wide variables'
;used in this routine.
;
CL ;Entry point for IVMLE CHANGE LIST protocol
; Input -- IVMEPSTA Error processing statuses
; Output -- IVMEPSTA Error processing statuses
; VALMSG Custom message
; VALMBCK R =Refresh screen
N DIR,DTOUT,DUOUT,Y
D FULL^VALM1
;
;Ask user to select error processing statuses
S DIR(0)="SMO^1:New;2:Checked;3:Both"
S DIR("A")="Select Error Processing Status"
D ^DIR
;
;Process user response
S:Y=3 Y="1^2"
I Y,"^1^2^"[(U_Y_U) D
. S IVMEPSTA=Y
. ;Re-build error list for selected statuses
. D BLD^IVMLERR
S VALMSG=$$MSG^IVMLERR
S VALMBCK="R"
Q
;
CD ;Entry point for IVMLE CHANGE DATE RANGE protocol
; Input -- IVMBEG Begin date
; IVMEND End date
; Output -- IVMBEG Begin date
; IVMEND End date
; VALMSG Custom message
; VALMBCK R =Refresh screen
N VALMB,VALMBEG,VALMEND
S VALMB=IVMBEG
;
;Ask user for date range
D RANGE^VALM1
;
;Process user response
I 'VALMBEG!((IVMBEG=VALMBEG)&(IVMEND=VALMEND)) D
. W !!,"Date Range was not changed."
. D PAUSE^VALM1
. S VALMBCK=""
ELSE D
. S IVMBEG=VALMBEG,IVMEND=VALMEND
. ;Re-build error list for selected date range
. D BLD^IVMLERR
. S VALMBCK="R"
S VALMSG=$$MSG^IVMLERR
Q
;
SL ;Entry point for IVMLE SORT LIST protocol
; Input -- IVMSRTBY Sort by criteria
; Output -- IVMSRTBY Sort by criteria
; VALMSG Custom message
; VALMBCK R =Refresh screen
N DIR,Y
D FULL^VALM1
;
;Ask user to select sort criteria
S DIR(0)="SMO^P:Patient Name;D:Date/Time ACK Received;E:Error Message"
S DIR("A")="Select Sort By"
S DIR("B")="P"
D ^DIR
S IVMY=$G(Y)
;S IVMSRTBY=$S($G(Y)="E":"E",$G(Y)="D":"D",1:"P")
;if sorting by error message ask if just Person Not Found
I $G(Y)="E" D
. N DIR,Y
. S DIR(0)="SMO^O:'Person Not Found' only;A:All Error Messages"
. S DIR("A")="Select ALL Error Messages or 'Person Not Found' only"
. D ^DIR
. I $D(DIRUT)!($D(DIROUT)) G ASK^IVMLERR
. ;if by 'Person Not Found' only, use Error Processing
. ;Status of NEW and CHECKED
. I $G(Y)="O" S IVMEPSTA="1^2",IVMY="O"
;if the report has not run once already, Q and return to
;INIT^IVMLERR
I $G(IVMFLG)=1 D Q
. S IVMFLG=0
. S IVMSRTBY=IVMY
;
;Process user response
I "^P^D^E^O^"[(U_IVMY_U),IVMSRTBY'=IVMY D
. S IVMSRTBY=IVMY
. ;Re-build error list for selected sort criteria
. D BLD^IVMLERR
S VALMSG=$$MSG^IVMLERR
S VALMBCK="R"
Q
;
CE ;Entry point for IVMLE CHECK ERROR OFF LIST protocol
; Input -- None
; Output -- VALMSG Custom message
; VALMBCK R =Refresh screen
N IVMLINE,IVMNUM,IVMTLIEN,VALMY
;
;Ask user to select transmission errors to check off the list
D EN^VALM2(XQORNOD(0))
D FULL^VALM1
;
;Process user selection
S IVMNUM=0
F S IVMNUM=$O(VALMY(IVMNUM)) Q:'IVMNUM D
. ;Invoke call to check error off list
. I $D(^TMP(IVMARY_"IDX",$J,IVMNUM)) S IVMLINE=+^(IVMNUM),IVMTLIEN=+$P(^(IVMNUM),U,2) D CHKERR(IVMARY,IVMLINE,IVMTLIEN)
S VALMBCK="R"
S VALMSG=$$MSG^IVMLERR
Q
;
CHKERR(IVMARY,IVMLINE,IVMTLIEN) ;Check error off list
; Input -- IVMARY Global array subscript
; IVMLINE Line number
; IVMTLIEN IVM transmission log IEN
; Output -- None
N IVMERMSG
I $$ERRSTAT^IVMTLOG(IVMTLIEN,2,.IVMERMSG) D
. D FLDTEXT^VALM10(IVMLINE,"STATUS","Checked")
. D FLDCTRL^VALM10(IVMLINE,"STATUS",IOINHI,IOINORM)
ELSE D
. W !,^TMP(IVMARY,$J,IVMLINE,0)
. W:$G(IVMERMSG)'="" !,"...",$$LOWER^VALM1(IVMERMSG)
. W !,"...Unable to check error off list"
. D PAUSE^VALM1
Q
;
RP ;Entry point for IVMLE RETRANSMIT PATIENT protocol
; Input -- None
; Output -- VALMSG Custom message
; VALMBCK R =Refresh screen
N IVMLINE,IVMNUM,IVMTLIEN,IVMTLOG,VALMY
;
;Ask user to select transmission errors to retransmit patient
D EN^VALM2(XQORNOD(0))
D FULL^VALM1
;
;Process user selection
S IVMNUM=0
F S IVMNUM=$O(VALMY(IVMNUM)) Q:'IVMNUM D
. I $D(^TMP(IVMARY_"IDX",$J,IVMNUM)) S IVMLINE=+^(IVMNUM),IVMTLIEN=+$P(^(IVMNUM),U,2) D
. . ;Get information for IVM transmission log entry and invoke code
. . ;to set patient to retransmit
. . I $$GET^IVMTLOG(IVMTLIEN,.IVMTLOG) D SETPAT(IVMARY,IVMLINE,.IVMTLOG)
S VALMBCK="R"
S VALMSG=$$MSG^IVMLERR
Q
;
SETPAT(IVMARY,IVMLINE,IVMTLOG) ;Set patient to retransmit
; Input -- IVMARY Global array subscript
; IVMLINE Line number
; IVMTLOG IVM transmission log entry array
; Output -- None
N IVMERMSG,IVMEVTS
M IVMEVTS=IVMTLOG("EVENTS")
;
;Set patient to retransmit
I $$SETSTAT^IVMPLOG(IVMTLOG("PAT"),.IVMEVTS,.IVMERMSG) D
. D UPDPAT(IVMARY,IVMTLOG("PAT"))
ELSE D
. W !,^TMP(IVMARY,$J,IVMLINE,0)
. W:$G(IVMERMSG)'="" !,"...",$$LOWER^VALM1(IVMERMSG)
. W !,"...Unable to set transmit flag for patient"
. D PAUSE^VALM1
Q
;
UPDPAT(IVMARY,IVMDFN) ;Update all IVM transmssion error log entries in the list
;for the patient as retransmit
; Input -- IVMARY Global array subscript
; IVMDFN IVM patient IEN
; Output -- None
N IVMLINE,IVMTLIEN
;
;Loop through entries in the list for the patient
S IVMLINE=0
F S IVMLINE=$O(^TMP(IVMARY_"IDX",$J,"PT",IVMDFN,IVMLINE)) Q:'IVMLINE S IVMTLIEN=+^(IVMLINE) D
. ;Update entry as retransmit
. D FLDTEXT^VALM10(IVMLINE,"RETRANSMIT","*")
. D FLDCTRL^VALM10(IVMLINE,"RETRANSMIT",IOINHI,IOINORM)
. ;Invoke code to check error off the list
. D CHKERR(IVMARY,IVMLINE,IVMTLIEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMLERR2 5914 printed Apr 09, 2024@21:01:46 Page 2
IVMLERR2 ;ALB/RMO,ERC - IVM Transmission Error Processing - Protocols; 15-SEP-1997 ; 5/29/07 9:29am
+1 ;;2.0;INCOME VERIFICATION MATCH;**9,121**; 21-OCT-94;Build 45
+2 ;
+3 ;This routine contains the IVM transmission log error processing
+4 ;protocols.
+5 ;
+6 ;See EN^IVMLERR1 for additional documentation on 'system wide variables'
+7 ;used in this routine.
+8 ;
CL ;Entry point for IVMLE CHANGE LIST protocol
+1 ; Input -- IVMEPSTA Error processing statuses
+2 ; Output -- IVMEPSTA Error processing statuses
+3 ; VALMSG Custom message
+4 ; VALMBCK R =Refresh screen
+5 NEW DIR,DTOUT,DUOUT,Y
+6 DO FULL^VALM1
+7 ;
+8 ;Ask user to select error processing statuses
+9 SET DIR(0)="SMO^1:New;2:Checked;3:Both"
+10 SET DIR("A")="Select Error Processing Status"
+11 DO ^DIR
+12 ;
+13 ;Process user response
+14 if Y=3
SET Y="1^2"
+15 IF Y
IF "^1^2^"[(U_Y_U)
Begin DoDot:1
+16 SET IVMEPSTA=Y
+17 ;Re-build error list for selected statuses
+18 DO BLD^IVMLERR
End DoDot:1
+19 SET VALMSG=$$MSG^IVMLERR
+20 SET VALMBCK="R"
+21 QUIT
+22 ;
CD ;Entry point for IVMLE CHANGE DATE RANGE protocol
+1 ; Input -- IVMBEG Begin date
+2 ; IVMEND End date
+3 ; Output -- IVMBEG Begin date
+4 ; IVMEND End date
+5 ; VALMSG Custom message
+6 ; VALMBCK R =Refresh screen
+7 NEW VALMB,VALMBEG,VALMEND
+8 SET VALMB=IVMBEG
+9 ;
+10 ;Ask user for date range
+11 DO RANGE^VALM1
+12 ;
+13 ;Process user response
+14 IF 'VALMBEG!((IVMBEG=VALMBEG)&(IVMEND=VALMEND))
Begin DoDot:1
+15 WRITE !!,"Date Range was not changed."
+16 DO PAUSE^VALM1
+17 SET VALMBCK=""
End DoDot:1
+18 IF '$TEST
Begin DoDot:1
+19 SET IVMBEG=VALMBEG
SET IVMEND=VALMEND
+20 ;Re-build error list for selected date range
+21 DO BLD^IVMLERR
+22 SET VALMBCK="R"
End DoDot:1
+23 SET VALMSG=$$MSG^IVMLERR
+24 QUIT
+25 ;
SL ;Entry point for IVMLE SORT LIST protocol
+1 ; Input -- IVMSRTBY Sort by criteria
+2 ; Output -- IVMSRTBY Sort by criteria
+3 ; VALMSG Custom message
+4 ; VALMBCK R =Refresh screen
+5 NEW DIR,Y
+6 DO FULL^VALM1
+7 ;
+8 ;Ask user to select sort criteria
+9 SET DIR(0)="SMO^P:Patient Name;D:Date/Time ACK Received;E:Error Message"
+10 SET DIR("A")="Select Sort By"
+11 SET DIR("B")="P"
+12 DO ^DIR
+13 SET IVMY=$GET(Y)
+14 ;S IVMSRTBY=$S($G(Y)="E":"E",$G(Y)="D":"D",1:"P")
+15 ;if sorting by error message ask if just Person Not Found
+16 IF $GET(Y)="E"
Begin DoDot:1
+17 NEW DIR,Y
+18 SET DIR(0)="SMO^O:'Person Not Found' only;A:All Error Messages"
+19 SET DIR("A")="Select ALL Error Messages or 'Person Not Found' only"
+20 DO ^DIR
+21 IF $DATA(DIRUT)!($DATA(DIROUT))
GOTO ASK^IVMLERR
+22 ;if by 'Person Not Found' only, use Error Processing
+23 ;Status of NEW and CHECKED
+24 IF $GET(Y)="O"
SET IVMEPSTA="1^2"
SET IVMY="O"
End DoDot:1
+25 ;if the report has not run once already, Q and return to
+26 ;INIT^IVMLERR
+27 IF $GET(IVMFLG)=1
Begin DoDot:1
+28 SET IVMFLG=0
+29 SET IVMSRTBY=IVMY
End DoDot:1
QUIT
+30 ;
+31 ;Process user response
+32 IF "^P^D^E^O^"[(U_IVMY_U)
IF IVMSRTBY'=IVMY
Begin DoDot:1
+33 SET IVMSRTBY=IVMY
+34 ;Re-build error list for selected sort criteria
+35 DO BLD^IVMLERR
End DoDot:1
+36 SET VALMSG=$$MSG^IVMLERR
+37 SET VALMBCK="R"
+38 QUIT
+39 ;
CE ;Entry point for IVMLE CHECK ERROR OFF LIST protocol
+1 ; Input -- None
+2 ; Output -- VALMSG Custom message
+3 ; VALMBCK R =Refresh screen
+4 NEW IVMLINE,IVMNUM,IVMTLIEN,VALMY
+5 ;
+6 ;Ask user to select transmission errors to check off the list
+7 DO EN^VALM2(XQORNOD(0))
+8 DO FULL^VALM1
+9 ;
+10 ;Process user selection
+11 SET IVMNUM=0
+12 FOR
SET IVMNUM=$ORDER(VALMY(IVMNUM))
if 'IVMNUM
QUIT
Begin DoDot:1
+13 ;Invoke call to check error off list
+14 IF $DATA(^TMP(IVMARY_"IDX",$JOB,IVMNUM))
SET IVMLINE=+^(IVMNUM)
SET IVMTLIEN=+$PIECE(^(IVMNUM),U,2)
DO CHKERR(IVMARY,IVMLINE,IVMTLIEN)
End DoDot:1
+15 SET VALMBCK="R"
+16 SET VALMSG=$$MSG^IVMLERR
+17 QUIT
+18 ;
CHKERR(IVMARY,IVMLINE,IVMTLIEN) ;Check error off list
+1 ; Input -- IVMARY Global array subscript
+2 ; IVMLINE Line number
+3 ; IVMTLIEN IVM transmission log IEN
+4 ; Output -- None
+5 NEW IVMERMSG
+6 IF $$ERRSTAT^IVMTLOG(IVMTLIEN,2,.IVMERMSG)
Begin DoDot:1
+7 DO FLDTEXT^VALM10(IVMLINE,"STATUS","Checked")
+8 DO FLDCTRL^VALM10(IVMLINE,"STATUS",IOINHI,IOINORM)
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 WRITE !,^TMP(IVMARY,$JOB,IVMLINE,0)
+11 if $GET(IVMERMSG)'=""
WRITE !,"...",$$LOWER^VALM1(IVMERMSG)
+12 WRITE !,"...Unable to check error off list"
+13 DO PAUSE^VALM1
End DoDot:1
+14 QUIT
+15 ;
RP ;Entry point for IVMLE RETRANSMIT PATIENT protocol
+1 ; Input -- None
+2 ; Output -- VALMSG Custom message
+3 ; VALMBCK R =Refresh screen
+4 NEW IVMLINE,IVMNUM,IVMTLIEN,IVMTLOG,VALMY
+5 ;
+6 ;Ask user to select transmission errors to retransmit patient
+7 DO EN^VALM2(XQORNOD(0))
+8 DO FULL^VALM1
+9 ;
+10 ;Process user selection
+11 SET IVMNUM=0
+12 FOR
SET IVMNUM=$ORDER(VALMY(IVMNUM))
if 'IVMNUM
QUIT
Begin DoDot:1
+13 IF $DATA(^TMP(IVMARY_"IDX",$JOB,IVMNUM))
SET IVMLINE=+^(IVMNUM)
SET IVMTLIEN=+$PIECE(^(IVMNUM),U,2)
Begin DoDot:2
+14 ;Get information for IVM transmission log entry and invoke code
+15 ;to set patient to retransmit
+16 IF $$GET^IVMTLOG(IVMTLIEN,.IVMTLOG)
DO SETPAT(IVMARY,IVMLINE,.IVMTLOG)
End DoDot:2
End DoDot:1
+17 SET VALMBCK="R"
+18 SET VALMSG=$$MSG^IVMLERR
+19 QUIT
+20 ;
SETPAT(IVMARY,IVMLINE,IVMTLOG) ;Set patient to retransmit
+1 ; Input -- IVMARY Global array subscript
+2 ; IVMLINE Line number
+3 ; IVMTLOG IVM transmission log entry array
+4 ; Output -- None
+5 NEW IVMERMSG,IVMEVTS
+6 MERGE IVMEVTS=IVMTLOG("EVENTS")
+7 ;
+8 ;Set patient to retransmit
+9 IF $$SETSTAT^IVMPLOG(IVMTLOG("PAT"),.IVMEVTS,.IVMERMSG)
Begin DoDot:1
+10 DO UPDPAT(IVMARY,IVMTLOG("PAT"))
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 WRITE !,^TMP(IVMARY,$JOB,IVMLINE,0)
+13 if $GET(IVMERMSG)'=""
WRITE !,"...",$$LOWER^VALM1(IVMERMSG)
+14 WRITE !,"...Unable to set transmit flag for patient"
+15 DO PAUSE^VALM1
End DoDot:1
+16 QUIT
+17 ;
UPDPAT(IVMARY,IVMDFN) ;Update all IVM transmssion error log entries in the list
+1 ;for the patient as retransmit
+2 ; Input -- IVMARY Global array subscript
+3 ; IVMDFN IVM patient IEN
+4 ; Output -- None
+5 NEW IVMLINE,IVMTLIEN
+6 ;
+7 ;Loop through entries in the list for the patient
+8 SET IVMLINE=0
+9 FOR
SET IVMLINE=$ORDER(^TMP(IVMARY_"IDX",$JOB,"PT",IVMDFN,IVMLINE))
if 'IVMLINE
QUIT
SET IVMTLIEN=+^(IVMLINE)
Begin DoDot:1
+10 ;Update entry as retransmit
+11 DO FLDTEXT^VALM10(IVMLINE,"RETRANSMIT","*")
+12 DO FLDCTRL^VALM10(IVMLINE,"RETRANSMIT",IOINHI,IOINORM)
+13 ;Invoke code to check error off the list
+14 DO CHKERR(IVMARY,IVMLINE,IVMTLIEN)
End DoDot:1
+15 QUIT
